home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173c_bas.zip / SOURCE / RBBSSUB4.BAS < prev    next >
BASIC Source File  |  1991-09-01  |  124KB  |  3,407 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB4.BAS 17.3C, Copyright 1986 - 91 by D. Thomas Mack'
  3. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB4.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1991; Sept 1, 1991
  7. '  Copyright ..........: 1986 - 1991
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  AnyBut         59760  Determine where a "word" begins
  18. '  AskUsers       64003  Ask users questions based on a script and save answers
  19. '  AskMore        59858  Check whether screen full
  20. '  AutoPage       60300  Check whether to notify sysop caller is on
  21. ' BadFileChar     59800  Check file name for bad character
  22. '  Bracket        59960  Puts strings around a substring
  23. '  BufFile        58400  Write a file to the user quickly
  24. '  BufString      58300  Write a string with imbedded CR/LF to the user quickly
  25. '  CheckColor     59930  Highlighting based on search string
  26. '  SearchArray    58190  Check for the occurance of a string in an array
  27. '  ColorDir       59920  Adds colorization to FMS directory entry
  28. '  ColorPrompt    59940  Colorizes prompts
  29. '  CompDate       59880+ Produces a computational data from YY, MM, DD
  30. '  ConfMail       59854  Check conference mail waiting
  31. '  ConvertDir     58950  Checks for U & A (shorthand) and converts appropriately
  32. '  PackDate       59201  Compress date in string format to 2 characters
  33. '  EofComm        60000  Determine whether any chars in comm port buffer
  34. '  ExpireDate     59890  Calculate registration expiration date
  35. '  FakeXRpt       62650  Write out file transfer report for protocols that don't
  36. '  FindEnd        58770  Find where a "word" ends
  37. '  FindFile       58790  Determine whether a file exists without opening it
  38. '  FindLast       58600  Find last occurence of a string
  39. '  FMS            58200  Search the upload management system for entries
  40. '  GetAll         59780  Get list of all directories to display
  41. '  GetDirs        58895  Prompts for directories for file list/new/search cmds
  42. '  GetMsgAttr     62530  Restore attributes of original message
  43. '  GetYMD         59204  Pulls YY, MM, or DD from a 2 byte stored date
  44. '  GlobalSrchRepl 60100  Global search and replace
  45. '  LogPDown       59400  Records download in private directory
  46. '  MarkTime       60200  Give visual feedback during lengthy process
  47. '  MetaGSR        60130  Meta statement global search and replace
  48. '  MsgImport      59698  Allow local user to import a text file to a message
  49. '  Muzak          59100  Play musical themes for different RBBS functions
  50. '  NewPassword    60668  Get a new password
  51. '  PersFile       59300  View and select personal files for downloading
  52. '  Protocol       62600  Determine if external protocols are available
  53. '  PutMsgAttr     62520  Save attributes of original message
  54. '  Remove         58210  Remove characters from within strings
  55. '  RotorsDir      58700  Searches for a file using list of subdirs
  56. '  RptTime        62540  Report date/time and time on
  57. '  SetEcho        59600  Set RBBS properly for who is to echo
  58. '  SetHiLite      59934  Set user preference on highlighting
  59. '  SetGraphic     59980  Sets graphic preference for text file display
  60. '  SmartText      58250  Process SMART TEXT control strings
  61. '  SubMenu        59500  Processes options that have sub-menus
  62. '  TimedOut       63000  Write timed exit semaphore file
  63. '  TimeLock       60180  Check for TIME LOCK on certain features
  64. '  Transfer       62624  RBBS-PC support for external protocols for file transfer
  65. '  Toggle         57000  Toggles or views user options
  66. ' TwoByteDate     59200  Reduces a data to 2 byte string for space compression
  67. '  UnPackDate     59902  Uncompresses a 2 byte date
  68. '  UserColor      59965  Lets user set color for text and whether bold
  69. '  UserFace       59450  Processes programmable user interface
  70. '  ViewArc        64600  Display .ARC file contents to user
  71. '  PrivDoorRtn    62629  Private door exit routine
  72. '  WipeLine       58800  Wipes away a line so next prints in its place
  73. '  WordWrap       59710  Adjust a msg -- wrap lines and perserve paragraphs
  74. '
  75. '  $INCLUDE: 'RBBS-VAR.BAS'
  76. '
  77. 57000 ' $SUBTITLE: 'Toggle - Toggle User Preferences'
  78. ' $PAGE
  79. '
  80. '  NAME    -- Toggle
  81. '
  82. '  INPUTS  -- ToggleOption      Option to toggle or view
  83. '                               according to the following:
  84. '    ToggleOption         PREFERENCE
  85. '   Toggle   VIEW
  86. '     1       -1           Autodownload
  87. '     2       -2           Bulletin review on logon
  88. '     3       -3           Case change
  89. '     4       -4           File review on logon
  90. '     5       -5           Highlight
  91. '     6       -6           Line feeds
  92. '     7       -7           Nulls
  93. '     8       -8           TurboKey
  94. '     9       -9           Expert
  95. '    10      -10           Bell
  96. '
  97. '  OUTPUTS -- ZSubParm   passed from TPut
  98. '
  99. '  PURPOSE -- Sets or views any single user preference value
  100. '
  101.       SUB Toggle (ToggleOption) STATIC
  102.       ZSubParm = 0
  103.       IF ToggleOption < 0 THEN _
  104.          GOTO 57005
  105.       ON ToggleOption GOSUB _
  106.          57010, _         'Autodownload
  107.          57120, _         'Bulletin review on logon
  108.          57260, _         'Case change
  109.          57150, _         'File review on logon
  110.          57040, _         'Highlight
  111.          57100, _         'Line feeds
  112.          57210, _         'Nulls
  113.          57230, _         'TurboKey
  114.          57190, _         'Expert
  115.          57170            'Bell
  116.       EXIT SUB
  117. 57005 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
  118.       ON -ToggleOption GOSUB _
  119.          57030, _         'Autodownload
  120.          57130, _         'Bulletin review on logon
  121.          57270, _         'Case change
  122.          57160, _         'File review on logon
  123.          57050, _         'Highlight
  124.          57110, _         'Line feeds
  125.          57220, _         'Nulls
  126.          57240, _         'TurboKey
  127.          57200, _         'Expert
  128.          57180            'Bell
  129.       EXIT SUB
  130. 57010 IF ZAutoDownDesired THEN _
  131.          GOTO 57020
  132.       IF NOT ZAutoDownVerified THEN _
  133.          CALL TestUser
  134.       IF NOT ZAutoDownYes THEN _
  135.          CALL QuickTPut1 ("Your comm pgm does not support AUTODOWNLOAD") : _
  136.          ZAutoDownDesired = ZTrue
  137. 57020 ZAutoDownDesired = NOT ZAutoDownDesired
  138. 57030 ZOutTxt$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
  139.      CALL QuickTPut1 (ZOutTxt$)
  140.      RETURN
  141. 57040 IF ZEmphasizeOnDef$ = "" THEN _
  142.         CALL QuickTPut1 ("Highlighting unavailable") : _
  143.         RETURN
  144.      IF NOT ZHiLiteOff THEN _
  145.         CALL QuickTPut (ZColorReset$,0)
  146.      CALL SetHiLite (NOT ZHiLiteOff)
  147.      GOSUB 57050
  148.      CALL UserColor
  149.      RETURN
  150. 57050 IF ZEmphasizeOn$ <> "" THEN _
  151.         ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  152.         ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  153.      CALL QuickTPut1 (ZEmphasizeOn$ + "Highlighting" + ZEmphasizeOff$ + _
  154.                  " " + FNOffOn$(NOT ZHiLiteOff))
  155.      RETURN
  156. 57100 ZLineFeeds = NOT ZLineFeeds
  157.       IF ZLocalUser THEN _
  158.          ZLineFeeds = ZTrue
  159. 57110 CALL QuickTPut1 ("Line Feeds " + FNOffOn$(ZLineFeeds))
  160.       CALL SetCrLf
  161.       RETURN
  162. 57120 ZCheckBulletLogon = NOT ZCheckBulletLogon
  163. 57130 ZOutTxt$ = MID$("Skip Check",1 -5 * ZCheckBulletLogon,5) + _
  164.            " old Bulletins in logon"
  165.       CALL QuickTPut1 (ZOutTxt$)
  166.       RETURN
  167. 57150 ZSkipFilesLogon = NOT ZSkipFilesLogon
  168. 57160 ZOutTxt$ = MID$("CheckSkip",1 -5 * ZSkipFilesLogon,5) + _
  169.            " new files in logon"
  170.       CALL QuickTPut1 (ZOutTxt$)
  171.       RETURN
  172. 57170 ZPromptBell = NOT ZPromptBell
  173. 57180 ZOutTxt$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  174.       CALL QuickTPut1 (ZOutTxt$)
  175.       RETURN
  176. 57190 ZExpertUser = NOT ZExpertUser
  177.       CALL SetExpert
  178. 57200 ZOutTxt$ = MID$("NoviceExpert",1 -6 * ZExpertUser,6)
  179.       CALL QuickTPut1 (ZOutTxt$)
  180.       RETURN
  181. 57210 ZNulls = NOT ZNulls
  182.       ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
  183.       CALL SetCrLf
  184. 57220 ZOutTxt$ = "Nulls " + FNOffOn$(ZNulls)
  185.       CALL QuickTPut1 (ZOutTxt$)
  186.       RETURN
  187. 57230 ZTurboKeyUser = NOT ZTurboKeyUser
  188. 57240 CALL QuickTPut1 ("TurboKey " + FNOffOn$(ZTurboKeyUser))
  189.       RETURN
  190. 57260 IF NOT ZUpperCase THEN _
  191.          IF (NOT ZHiLiteOff) OR ZUserGraphicDefault$ = "C" THEN _
  192.             CALL QuickTPut1 ("Graphics & Hilite must be OFF to use UpperCase") : _
  193.             RETURN
  194.       ZUpperCase = NOT ZUpperCase
  195. 57270 ZOutTxt$ = "UPPER CASE " + _
  196.             MID$("and lowerONLY",1 - 9 * ZUpperCase,9)
  197.       CALL QuickTPut1 (ZOutTxt$)
  198. 57280 ZUseTPut = (ZUpperCase OR ZXOnXOff)
  199.       RETURN
  200.       END SUB
  201. '
  202. 58190 ' $SUBTITLE: 'SearchArray - subroutine to check for a string in an array'
  203. ' $PAGE
  204. '
  205. '  NAME    -- SearchArray
  206. '
  207. '  INPUTS  -- PARAMETER                      MEANING
  208. '             Element$                THE STRING TO CHECK FOR
  209. '             Array$()                THE ARRAY TO BE SEARCHED
  210. '             NumEntriesToSearch      NUMBER OF ENTRIES WITHIN IN
  211. '                                     THE ARRAY TO BE SEARCHED
  212. '
  213. '  OUTPUTS -- IsInAra                 0 = STRING NOT Found IN THE
  214. '                                         ARRAY SPECIFIED
  215. '                                     OTHERWISE IT IS THE NUMBER sOF
  216. '                                     ELEMENT WITHIN THE ARRAY THAT
  217. '                                     WAS Found TO MATCH
  218. '
  219. '  PURPOSE -- Search an array for a specified string and, if found,
  220. '             return the number of the element that matched.
  221. '
  222.       SUB SearchArray (Element$,Array$(1),NumEntriesToSearch,IsInAra) STATIC
  223.       IsInAra = 1
  224.       CALL AllCaps (Element$)
  225.       MaxTries = NumEntriesToSearch + 1
  226.       Array$(MaxTries) = Element$
  227.       WHILE Array$(IsInAra) <> Element$
  228.          IsInAra = IsInAra + 1
  229.       WEND
  230.       IF IsInAra = MaxTries THEN _
  231.          IsInAra = 0
  232.       END SUB
  233. 58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system'
  234. ' $PAGE
  235. '
  236. '  NAME    -- FMS
  237. '
  238. '  INPUTS  -- PARAMETER                      MEANING
  239. '             DirToSearch$          RBBS-PC "DIR" CATEGORY TO LOOK
  240. '                                     FOR
  241. '             SearchString$          STRING TO SEARCH FOR
  242. '             SearchDate$            DATE TO SEARCH FOR
  243. '             ZCategoryName$()
  244. '             ZCategoryCode$()
  245. '             ZCategoryDesc$()
  246. '             CatFound
  247. '             ZNumCategories
  248. '
  249. '  OUTPUTS -- ProcessedInFMS
  250. '             DnldFlag
  251. '
  252. '  PURPOSE -- To search the file management system and display the
  253. '             files being searched for as well as the catetory descriptions
  254. '
  255.       SUB FMS (DirToSearch$,SearchString$,SearchDate$, _
  256.                ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _
  257.                ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC
  258.       DnldFlag = 0
  259.       CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound)
  260.       ProcessedInFMS = ProcessedInFMS OR (CatFound > 0)
  261.       IF ProcessedInFMS THEN _
  262.          ZSubParm = 5 : _
  263.          GOSUB 58202 : _
  264.          ZOutTxt$ = "Scanning directory " + _
  265.               DirToSearch$ + _
  266.               SrchDir$ + _
  267.               " - " + _
  268.               ZCategoryDesc$(CatFound) : _
  269.          CALL TPut : _
  270.          Cat$ = ZCategoryCode$(CatFound) : _
  271.          CALL DispUpDir (Cat$,SearchString$,SearchDate$,DnldFlag,AbortIndex)
  272.       EXIT SUB
  273. 58202 ZOutTxt$ = SearchDate$
  274.       IF LEN(ZOutTxt$) > 0 THEN _
  275.          ZOutTxt$ = MID$(ZOutTxt$,3) + LEFT$(ZOutTxt$,2)
  276.       SrchDir$ = " for " + _
  277.              SearchString$ + _
  278.              ZOutTxt$
  279.       IF LEN(SrchDir$) < 6 THEN _
  280.          SrchDir$ = ""
  281.       RETURN
  282.       END SUB
  283. 58210 ' $SUBTITLE: 'Remove - subroutine to delete a string from within a string'
  284. ' $PAGE
  285. '
  286. '  NAME    -- Remove
  287. '
  288. '  INPUTS  -- PARAMETER                      MEANING
  289. '             BADSTRING$              STRING CONTAINING CHARACTERS
  290. '                                     TO BE DELETED FROM "WasL$"
  291. '             WasL$                      STRING TO BE ALTERED
  292. '
  293. '  OUTPUTS -- WasL$                      WITH THE CHARACTERS IN
  294. '                                     "BADSTRING#" DELETED FROM IT
  295. '
  296. '  PURPOSE -- To remove all instances of the characters in
  297. '                        "BADSTRING$" from "WasL$"
  298. '
  299.       SUB Remove (WasL$,BadString$) STATIC
  300.       WasJ = 0
  301.       FOR WasI=1 TO LEN(WasL$)
  302.          IF INSTR(BadString$,MID$(WasL$,WasI,1)) = 0 THEN _
  303.             WasJ = WasJ + 1 : _
  304.             MID$(WasL$,WasJ,1) = MID$(WasL$,WasI,1)
  305.       NEXT WasI
  306.       WasL$ = LEFT$(WasL$,WasJ)
  307.       END SUB
  308. '
  309. 58250 ' $SUBTITLE: 'SmartText - smart text substitution'
  310. ' $PAGE
  311. '
  312. '  NAME    -- SmartText   (WRITTEN BY DOUG AZZARITO)
  313. '
  314. '  INPUTS  -- StringWork$        string to scan for Smart Text
  315. '             CRFound            Does this line contain a CR?
  316. '             ZSmartTextCode     Smart Text control code
  317. '
  318. '  OUTPUTS -- StringWork$        Input string with Smart replaced
  319. '
  320. '  PURPOSE -- Smart Text allows control strings in text files
  321. '             to be replaced at runtime with user info or other
  322. '             data.  The Smart Text control code is a 1-byte
  323. '             code (configurable) with a 2-byte action code.
  324. '
  325.       SUB SmartText (StringWork$, CRFound, OverStrike) STATIC
  326.       IF SmartCarry$<>"" THEN _
  327.          StringWork$ = SmartCarry$+StringWork$
  328.       Index = INSTR(StringWork$, ZSmartTextCode$)
  329.       WHILE Index > 0 AND Index < LEN(StringWork$)-1
  330.          IF INSTR(MID$(StringWork$, Index+1,2)," ") THEN _
  331.             SmartAct = 0 _
  332.          ELSE _
  333.             SmartAct = INSTR(ZSmartTable$, MID$(StringWork$, Index+1, 2))
  334.          IF SmartAct = 0 THEN _
  335.             WasI = 1 : _
  336.             GOTO 58254
  337.          SmartAct = (SmartAct+2)/3
  338.          ON SmartAct GOSUB 58260, 58261, 58262, 58263, 58264, 58265, _
  339.                            58266, 58267, 58268, 58269, 58270, _
  340.                            58271, 58272, 58273, 58274, 58275, _
  341.                            58276, 58277, 58278, 58279, 58280, _
  342.                            58281, 58282, 58283, 58284, 58285, _
  343.                            58286, 58287, 58289, 58290, 58291, _
  344.                            58292, 58293, 58294
  345.          GOSUB 58256
  346.          WasI = LEN(SmartHold$)
  347.          ReplaceLen = 3
  348.          IF OverStrike OR Overlay THEN _
  349.             IF WasI > 2 THEN _
  350.                ReplaceLen = WasI _
  351.             ELSE _
  352.                SmartHold$ = SmartHold$ + SPACE$(3 - WasI)
  353.          StringWork$ = LEFT$(StringWork$, Index-1) + SmartHold$ + _
  354.                        MID$(StringWork$,Index+ReplaceLen)
  355. 58254    Index = INSTR(Index+WasI, StringWork$, ZSmartTextCode$)
  356.       WEND
  357.       IF Index AND (Index > LEN(StringWork$)-2) AND NOT CRFound THEN _
  358.          SmartCarry$ = MID$(StringWork$,Index) : _
  359.          StringWork$ = LEFT$(StringWork$,Index-1) : _
  360.       ELSE _
  361.          SmartCarry$ = ""
  362.       EXIT SUB
  363. 58256 IF TrimSmart THEN _
  364.          CALL Trim (SmartHold$)
  365.       RETURN
  366. 58258 ZLastSmartColor$ = SmartHold$
  367.       RETURN
  368. 58260 ZLinesPrinted = 0                     ' CS (Clear screen line count reset)
  369.       SmartHold$ = ""
  370.       RETURN
  371. 58261 ZLinesPrinted = ZPageLength           ' PB Page Break
  372.       IF ZNonStop THEN _                    ' force a 1-time pause
  373.          ZOneStop = ZTrue : _               ' if NON STOP is on
  374.          ZNonStop = ZFalse
  375.       SmartHold$ = ""
  376.       ZForceKeyboard = ZTrue
  377.       RETURN
  378. 58262 ZNonStop = ZTrue                      ' NS Non-stop
  379.       SmartHold$ = ""
  380.       RETURN
  381. 58263 IF ZGlobalSysop THEN _                ' FN First Name
  382.          SmartHold$ = ZOrigSysopFN$ _
  383.       ELSE SmartHold$ = ZFirstName$
  384.       CALL NameCaps(SmartHold$)
  385.       RETURN
  386. 58264 IF ZGlobalSysop THEN _
  387.          SmartHold$ = ZOrigSysopLN$ _
  388.       ELSE SmartHold$ = ZLastName$
  389.       CALL NameCaps(SmartHold$)
  390.       RETURN
  391. 58265 SmartHold$ = STR$(ZUserSecLevel)     ' SL Security level
  392.       CALL Trim (SmartHold$)
  393.       RETURN
  394. 58266 SmartHold$ = DATE$                         ' DT Date
  395.       RETURN
  396. 58267 CALL AMorPM
  397.       SmartHold$ = ZTime$                        ' TM Time
  398.       RETURN
  399. 58268 CALL TimeRemain(MinsRemaining)
  400.       SmartHold$ = MID$(STR$(INT(MinsRemaining)),2)
  401.       RETURN
  402. 58269 CALL TimeRemain(MinsRemaining)      ' TE Time elapsed (mm:ss)
  403.       SmartHold$ = MID$(STR$(INT(ZSecsUsedSession!/60)),2)+":"+ _
  404.          MID$(STR$((ZSecsUsedSession! MOD 60)+100),3)
  405.       RETURN
  406. 58270 SmartHold$ = MID$(STR$(INT((ZTimeLockSet+0.5)/60)),2) ' TL - Time Lock period
  407.       SmartHold$ = SmartHold$ + ":"+ MID$(STR$((ZTimeLockSet MOD 60)+100),3)
  408.       RETURN
  409. 58271 SmartHold$ = MID$(STR$(ZDaysInRegPeriod),2)
  410.       RETURN                                ' RP Registration Length
  411. 58272 SmartHold$ = MID$(STR$(ZRegDaysRemaining),2)
  412.       RETURN                                ' RR Registration Remaining
  413. 58273 SmartHold$ = ZCityState$              ' CT Users CITY & STATE
  414.       RETURN
  415. 58274 SmartHold$ = ZFG1$                    ' C1 Color 1
  416.       GOTO 58258
  417. 58275 SmartHold$ = ZFG2$                    ' C2 Color 2
  418.       GOTO 58258
  419. 58276 SmartHold$ = ZFG3$                    ' C3 Color 3
  420.       GOTO 58258
  421. 58277 SmartHold$ = ZFG4$                    ' C4 Color 4
  422.       GOTO 58258
  423. 58278 SmartHold$ = ZEmphasizeOff$           ' C0 Reset color
  424.       ZLastSmartColor$ = ""
  425.       RETURN
  426. 58279 SmartHold$ = MID$(STR$(INT(ZDLToday!)),2)
  427.       RETURN                                ' DD files Dnlded TODAY
  428. 58280 SmartHold$ = MID$(STR$(INT(ZBytesToday!)),2)
  429.       RETURN                                ' BD Bytes Dnlded TODAY
  430. 58281 SmartHold$ = MID$(STR$(INT(ZDLBytes!)),2)
  431.       RETURN                                ' DB Download Bytes
  432. 58282 SmartHold$ = MID$(STR$(INT(ZULBytes!)),2)
  433.       RETURN                                ' UB Upload Bytes
  434. 58283 SmartHold$ = MID$(STR$(ZDnlds),2)     ' DL Number of Dnlds
  435.       RETURN
  436. 58284 SmartHold$ = MID$(STR$(ZUplds),2)     ' UL Number of Uplds
  437.       RETURN
  438. 58285 SmartHold$ = ZFileName$               ' FI  File Name
  439.       RETURN
  440. 58286 Overlay = ZTrue                       ' VY Overlay ON
  441.       GOTO 58288
  442. 58287 Overlay = ZFalse                      ' VN Overlay OFF
  443. 58288 SmartHold$ = ""
  444.       RETURN
  445. 58289 TrimSmart = ZTrue                     ' TY Trim Yes
  446.       GOTO 58288
  447. 58290 TrimSmart = ZFalse                    ' TN Trim No
  448.       GOTO 58288
  449. 58291 SmartHold$ = ZRBBSName$               ' BN Board Name
  450.       RETURN
  451. 58292 SmartHold$ = ZNodeID$                 ' ND Node Number
  452.       IF SmartHold$ >= "A" THEN _
  453.          SmartHold$ = MID$(STR$(ASC(SmartHold$) - 54),2)
  454.       RETURN
  455. 58293 SmartHold$ = ZSysopFirstName$          ' FS Sysops First Name
  456.       CALL NameCaps(SmartHold$)
  457.       RETURN
  458. 58294 SmartHold$ = ZSysopLastName$          ' LS Sysops First Name
  459.       CALL NameCaps(SmartHold$)
  460.       RETURN
  461.       END SUB
  462. '
  463. 58300 ' $SUBTITLE: 'BufString - write a string with imbedded ZCR/LF'
  464. ' $PAGE
  465. '
  466. '  NAME    -- BufString
  467. '
  468. '  INPUTS  -- PARAMETER                      MEANING
  469. '             Strng$                  STRING TO BE WRITTEN OUT
  470. '             DataSize               LENGTH OF STRING - # LEFT
  471. '                                        CHARS TO OUTPUT
  472. '
  473. '  OUTPUTS -- Strng$                  IS WRITTEN TO THE USER
  474. '
  475. '  PURPOSE -- To search the string, Strng$, for embedded carriage
  476. '             returns and line feeds and write out each line with
  477. '             the appropriate substitution (cr/lf if to the local
  478. '             screen or cr/nulls/lf if to the communications port).
  479. '
  480.       SUB BufString (Strng$,PassedDataSize,AbortIndex) STATIC
  481.       WasL = LEN(Strng$)
  482.       IF PassedDataSize < WasL THEN _
  483.          WasL = PassedDataSize
  484.       IF WasL < 1 THEN _
  485.          EXIT SUB
  486.       ZFF = ZPageLength - 1
  487.       StartByte = 1
  488.       ZRet = ZFalse
  489.       IF CarryOver THEN _
  490.          IF ASC(Strng$) = 10 THEN _
  491.             StartByte = 2 : _
  492.             CALL SkipLine (1+ZJumpSearching)
  493.       CarryOver = (MID$(Strng$,WasL,1) = ZCarriageReturn$)
  494.       WasL = WasL + CarryOver
  495. 58301 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  496.       IF CRat > 0 AND CRat < WasL THEN _
  497.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  498.       ELSE CRFound = ZFalse
  499.       EOLlen = -2 * CRFound
  500.       IF CRFound THEN _
  501.          EOD = CRat _
  502.       ELSE EOD = WasL + 1
  503.       NumBytes = EOD - StartByte
  504.       StringWork$ = MID$(Strng$,StartByte,NumBytes)
  505.       IF NOT ZDeleteInvalid THEN _
  506.          GOTO 58302
  507.       Index = INSTR(StringWork$,"[")
  508.       WasJ = LEN(StringWork$) - 1
  509.       WHILE Index > 0 AND Index < WasJ
  510.          IF MID$(StringWork$,Index + 2,1) = "]" THEN _
  511.             IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _
  512.                MID$(StringWork$,Index + 1,1) = "*"
  513.          Index = INSTR(Index + 1,StringWork$,"[")
  514.       WEND
  515. 58302 IF ZJumpSearching THEN _
  516.          Temp$ = StringWork$ : _
  517.          CALL AllCaps (Temp$) : _
  518.          HiLitePos = INSTR (Temp$,ZJumpTo$) : _
  519.          IF HiLitePos = 0 THEN _
  520.             GOTO 58307 _
  521.          ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _
  522.               ZJumpSearching = ZFalse
  523.       IF ZSmartTextCode THEN _
  524.          CALL SmartText (StringWork$, CRFound, ZFalse)
  525.       IF NOT ZLocalUser THEN _
  526.          CALL EofComm (Char) : _
  527.          IF Char <> -1 THEN _
  528.             GOTO 58303            ' comm port input
  529.       ZKeyboardStack$ = INKEY$ : _
  530.       IF ZKeyboardStack$ <> "" THEN _  ' keyboard input
  531.          GOTO 58303
  532.       CALL QuickTPut (StringWork$, - (CRFound))
  533.       GOTO 58304
  534. 58303 ZOutTxt$ = StringWork$
  535.       ZSubParm = 4
  536.       IF CRFound THEN ZSubParm = 5
  537.       CALL TPut
  538. 58304 IF ZRet THEN _
  539.          EXIT SUB
  540.       IF ZLinesPrinted < ZFF THEN _
  541.          GOTO 58307
  542. 58305 CALL CheckTimeRemain (MinsRemaining)
  543.       CALL CheckCarrier
  544.       IF ZSubParm = -1 THEN _
  545.          EXIT SUB
  546.       IF ZNonStop THEN _
  547.          GOTO 58307
  548.       IF NOT CRFound THEN _
  549.          GOTO 58307
  550.       ZForceKeyboard = ZTrue
  551.       CALL AskMore ("",ZTrue,ZFalse,AbortIndex,ZStopInterrupts)
  552.       IF ZNo THEN _
  553.          ZRet = ZTrue : _
  554.          EXIT SUB
  555. 58307 StartByte = EOD + EOLlen
  556.       IF StartByte <= WasL THEN _
  557.          GOTO 58301
  558.       END SUB
  559. 58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user'
  560. ' $PAGE
  561. '
  562. '  NAME    -- BufFile
  563. '
  564. '  INPUTS  -- PARAMETER                      MEANING
  565. '             FileSpec$               NAME OF THE FILE TO WRITE TO
  566. '                                                OUT TO THE USER
  567. '
  568. '  OUTPUTS -- NONE                    FILE IS WRITTEN TO THE USER
  569. '
  570. '  PURPOSE -- To display a sequential file to the user
  571. '
  572.       SUB BufFile (FilName$,AbortIndex) STATIC
  573.       CALL FindIt (FilName$)
  574.       IF NOT ZOK THEN _
  575.          GOTO 58419
  576.       ZNo = ZFalse
  577.       CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize)
  578.       IF ZErrCode > 0 THEN _
  579.          GOTO 58419
  580.       DataSize = ZBufferSize
  581.       FIELD 2, DataSize AS SeqRec$
  582.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  583.       ZJumpLast$ = ""
  584.       ZJumpSearching = ZFalse
  585.       ZJumpSupported = ZTrue
  586.       IF NOT ZStopInterrupts THEN _
  587.          IF NOT ZConcatFIles THEN _
  588.             IF NOT ZNonStop THEN _
  589.                ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _
  590.                ZSubParm = 2 : _
  591.                CALL TPut
  592.       WasTU = 0
  593. 58405 WasTU = WasTU + 1
  594.       IF WasTU < NumRecs THEN _
  595.          GET 2,WasTU _
  596.       ELSE IF WasTU = NumRecs THEN _
  597.               GET 2,WasTU : _
  598.               WasX = INSTR(SeqRec$,CHR$(26)) : _
  599.               IF WasX = 0 OR WasX > LenLastRec THEN _
  600.                  DataSize = LenLastRec _
  601.               ELSE DataSize = WasX - 1 _
  602.            ELSE GOTO 58419
  603.       CALL BufString (SeqRec$,DataSize,AbortIndex)
  604. 58408 IF ZSubParm <> -1 AND NOT ZRet THEN _
  605.          GOTO 58405
  606. 58419 CLOSE 2
  607.       ZBypassTimeCheck = ZFalse
  608.       ZStopInterrupts = ZFalse
  609.       CALL QuickTPut (ZEmphasizeOff$,0)
  610.       ZJumpSupported = ZFalse
  611.       END SUB
  612. 58600 ' $SUBTITLE: 'FindLast - find last occurence of a string'
  613. ' $PAGE
  614. '
  615. '  NAME    -- FindLast
  616. '
  617. '  INPUTS  -- PARAMETER             MEANING
  618. '              LookIn$           STRING TO LOOK INTO
  619. '              LookFor$          STRING TO SEARCH FOR
  620. '
  621. '  OUTPUTS -- WhereFound        POSITION IN LookIn$ THAT
  622. '                                   LookFor$ Found
  623. '             NumFinds          HOW MANY OCCURENCES IN LookIn$
  624. '
  625. '  PURPOSE -- Finds last occurence of LookFor$ in LookIn$ and
  626. '             returns count of # of occurences.  If none found,
  627. '             both returned parameters are set to 0.
  628. '
  629.       SUB FindLast (LookIn$,LookFor$,WhereFound,NumFinds) STATIC
  630.       WhereFound = INSTR(LookIn$,LookFor$)
  631.       NumFinds = -(WhereFound > 0)
  632.       NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  633.       WHILE NextFound > 0
  634.          NumFinds = NumFinds + 1
  635.          WhereFound = NextFound
  636.          NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  637.       WEND
  638.       END SUB
  639. 58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file'
  640. ' $PAGE
  641. '
  642. '  NAME    -- RotorsDir
  643. '
  644. '  INPUTS  --     PARAMETER                    MEANING
  645. '             FilName$                  FILE NAME TO LOOK FOR
  646. '             SDIR.ARA                  ARRAY OF SUBDIRECTORIES
  647. '             MaxSearch                 MAX # OF SUBDIRECTORIES
  648. '             MarkingTime               WHETHER TO MARK TIME
  649. '
  650. '  OUTPUTS -- FNAME$                    ADD SUBDIRECTORY TO THE
  651. '                                       FILE NAME IF FOUND.  OTHER-
  652. '                                       WISE DON'T.
  653. '             ZOK                       TRUE IF FILE WAS Found
  654. '
  655. '  PURPOSE -- Hunt through a list of subdirectories to determine
  656. '             if a file is in any of them.  If file is found, open
  657. '             the file as file #2, add the drive/path to the file
  658. '             name, and sets ZOK to true.  If file isn't found, set
  659. '             file name to the last subdirectory searched -- which
  660. '             should be the upload subdirectory.
  661. '
  662. '             If the library menu is selected (ZMenuIndex = 6), then
  663. '             only 2 subdirectories are searched. The first being
  664. '             the work disk and the second being the selected
  665. '             library disk.
  666. '
  667.       SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime,PassToMacro$) STATIC
  668.       ZOK = ZFalse
  669.       ZDotFlag = ZFalse
  670.       IF MarkingTime THEN _
  671.          CALL QuickTPut ("Searching for "+FilName$,0)
  672.       IF ZMenuIndex = 6 THEN _
  673.          GOTO 58705
  674.       NumSearch = 1
  675.       WasX = 0
  676.       WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _
  677.          SDirAra$(NumSearch) <> ""
  678.          IF MarkingTime THEN _
  679.             CALL MarkTime (WasX)
  680.          WasX$ = SDirAra$(NumSearch) + _
  681.               FilName$
  682.          CALL FindFile (WasX$,ZOK)
  683.          NumSearch = NumSearch + 1
  684.       WEND
  685.       IF ZOK OR NOT ZFastFileSearch THEN _
  686.          GOTO 58710
  687.       CALL OpenRSeq (ZFastFileList$,HighRec,WasX,18)
  688.       IF ZErrCode <> 0 THEN _
  689.          GOTO 58710
  690.       CALL TrimTrail (FilName$,".")
  691.       CALL BinSearch (FilName$,1,12,18,HighRec,RecFoundAt, RecFound$)
  692.       ZOK = (RecFoundAt > 0)
  693.       IF NOT ZOK THEN _
  694.          GOTO 58710
  695.       ZOK = ZFalse
  696.       CALL CheckInt (MID$(RecFound$,13,4))
  697.       IF ZTestedIntValue < 1 THEN _
  698.          GOTO 58710
  699.       CALL OpenRSeq (ZFastFileLocator$,HighRec,WasX,66)
  700.       IF ZErrCode <> 0 OR ZTestedIntValue > HighRec THEN _
  701.          GOTO 58710
  702.       FIELD 2, 66 AS LocatorRec$
  703.       GET 2, ZTestedIntValue
  704.       WasX$ = LEFT$(LocatorRec$,63)
  705.       CALL Trim (WasX$)
  706.       IF LEFT$(WasX$,2) = "M!" THEN _
  707.          ZOK = ZFalse : _
  708.          ZGSRAra$(1) = PassToMacro$ : _
  709.          WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _
  710.          CALL Trim (WasX$) : _
  711.          ZFileLocation$ = "" : _
  712.          CALL MacroExe (WasX$) : _
  713.          IF ZFileLocation$ = "" THEN _
  714.             ZOK = ZFalse : _
  715.             GOTO 58711 _
  716.          ELSE WasX$ = ZFileLocation$
  717.       WasX$ = WasX$ + FilName$
  718.       CALL FindFile (WasX$,ZOK)
  719.       IF NOT ZOK THEN _
  720.          WasX$ = SDirAra$(MaxSearch) + FilName$
  721.       GOTO 58710
  722. 58705 WasX$ = ZLibWorkDiskPath$ + _
  723.            FilName$
  724.       CALL FindIt (WasX$)
  725.       IF ZOK THEN _
  726.          GOTO 58710
  727.       WasX$ = ZLibDrive$ + _
  728.            FilName$
  729.       CALL FindIt (WasX$)
  730. 58710 FilName$ = WasX$
  731. 58711 CALL SkipLine (-MarkingTime)
  732.       END SUB
  733. 58800 ' $SUBTITLE: 'WipeLine - Wipe away a line so next overprints'
  734. ' $PAGE
  735. '
  736. '  NAME    -- WipeLine
  737. '
  738. '  INPUTS  --     PARAMETER                    MEANING
  739. '                 ZCarriageReturn$
  740. '                 CharsToWipe            # OF CHARACTERS TO BLANK
  741. '                 ZNulls
  742. '
  743. '  OUTPUTS -- NONE
  744. '
  745. '  PURPOSE -- Wipe away a line and leave cursor at beginning of the
  746. '             same line so that the next line will print in its place
  747. '
  748.       SUB WipeLine (CharsToWipe) STATIC
  749.       IF ZNulls OR CharsToWipe > 79 THEN _
  750.          CALL SkipLine (1) : _
  751.          EXIT SUB
  752.       IF NOT ZLocalUser THEN _
  753.          Strng$ = ZCarriageReturn$ + SPACE$(CharsToWipe) + ZCarriageReturn$ : _
  754.          CALL PutCom (Strng$)
  755.       IF ZSnoop THEN _
  756.          LOCATE ,1 :  _
  757.          CALL LPrnt(SPACE$(CharsToWipe),0) : _
  758.          LOCATE ,1
  759.       IF ZF7Msg$ = "" OR _
  760.          ZF7Msg$ = "NONE" OR _
  761.          NOT ZSysopNext THEN _
  762.          EXIT SUB
  763.       ZBypassTimeCheck = ZTrue
  764.       CALL BufFile (ZF7Msg$,WasX)
  765.       END SUB
  766. 58895 ' $SUBTITLE: 'GetDirs -- Prompt for directories to search'
  767. ' $PAGE
  768. '
  769. '  NAME    -- GetDirs
  770. '
  771. '  INPUTS  --     PARAMETER                    MEANING
  772. '                 ZDirPrompt$             BASE OF DIRECTORY PROMPT
  773. '                 ShowHelp               Whether to display help
  774. '                                            on entry
  775. '  OUTPUTS --     ZUserIn$
  776. '                 ZWasQ
  777. '
  778. '  PURPOSE -- Prompt for directories to search
  779. '
  780.       SUB GetDirs (ShowHelp) STATIC
  781.       IF ShowHelp AND (ZAnsIndex >= ZLastIndex ) THEN _
  782.          GOTO 58902
  783. 58900 ZOutTxt$ = ZDirPrompt$
  784.       ZMacroMin = 2
  785.       CALL PopCmdStack
  786.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  787.          EXIT SUB
  788.       CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
  789.       IF ZUserIn$(ZAnsIndex) = "Q" THEN _
  790.          ZWasQ = 0 : _
  791.          EXIT SUB
  792.       ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
  793.       IF ZWasA = 0 THEN _
  794.          EXIT SUB
  795.       IF ZWasA > 8 THEN _
  796.          IF ZAnsIndex < ZLastIndex THEN _
  797.             GOTO 58900 _
  798.          ELSE GOTO 58902
  799.       IF ZWasA = 7 THEN _
  800.          ZExtendedOff = NOT ZExtendedOff _
  801.       ELSE ZExtendedOff = (ZWasA > 3)
  802.       CALL QuickTPut1 ("Extended directory display "+FNOffOn$(NOT ZExtendedOff))
  803.       GOTO 58900
  804. 58902 ZFileName$ = ZCurDirPath$ + ZDirPrefix$ + _
  805.                     "." + ZDirExtension$
  806.       GDefault$ = MID$(" GC",ZWasGR + 1, 1)
  807.       CALL Graphic (GDefault$,ZFileName$)
  808.       CALL BufFile (ZFileName$,ZAnsIndex)
  809.       GOTO 58900
  810.       END SUB
  811. '
  812. 58950 ' $SUBTITLE: 'ConvertDir -- Converts coded response to right directory'
  813. ' $PAGE
  814. '
  815. '  NAME    -- ConvertDir
  816. '
  817. '  INPUTS  --     PARAMETER                    MEANING
  818. '                 Start               ELEMENT TO BEGIN WITH
  819. '                 ZUserIn$            ARRAY TO CONVERT
  820. '                 ZWasQ               Last ELEMENT TO CONVERT
  821. '
  822. '  OUTPUTS --     ZUserIn$            CONVERTED DIRECTORY LIST
  823. '
  824. '  PURPOSE -- Let the user put in a short standard string for a directory
  825. '
  826. '
  827.       SUB ConvertDir (Start) STATIC
  828.       FOR WasI=Start TO ZLastIndex
  829.          CALL AraAllCaps (ZUserIn$(),WasI)
  830.          IF ZUserIn$(WasI)="U" THEN _
  831.             ZUserIn$(WasI) = ZUpldDirCheck$
  832.          IF ZUserIn$(WasI) = "A" THEN _
  833.             ZUserIn$(WasI) = "ALL"
  834.       NEXT
  835.       END SUB
  836. 59100 ' $SUBTITLE: 'Muzak - subroutine to PLAY ZMusic'
  837. ' $PAGE
  838. '
  839. '  NAME    -- Muzak
  840. '
  841. '  INPUTS  --   PARAMETER     MEANING
  842. '                       1   PLAY CONSIDER YOURSELF(OPENING SCREEN)
  843. '                       2   PLAY WALK RIGHT IN(NEW USERS)
  844. '                       3   PLAY DRAGNET (SECURITY VIOLATION)
  845. '                       4   PLAY GOODBYE CHARLIE (GOODBYE)
  846. '                       5   PLAY TAPS (ACCESS DENIED)
  847. '                       6   PLAY OOM PAH PAH (DOWNLOAD)
  848. '                       7   PLAY THNKS FOR MEMORIES(UPLOAD)
  849. '
  850. '  OUTPUTS -- NONE
  851. '
  852. '  PURPOSE -- Provide sysops and the visually impaired with
  853. '             auditory feedback on what RBBS-PC is doing
  854. '
  855.       SUB Muzak (PassedArg) STATIC
  856.       ZFF = PassedArg
  857.       ZSubParm = 0
  858.       IF (NOT ZSnoop) OR (NOT ZMusic) OR ZLocalUserMode THEN _
  859.          EXIT SUB
  860.       ON ZFF GOTO 59102,59104,59106,59108,59110,59112,59114
  861.       EXIT SUB
  862. 59102 '---[Introduction CONSIDER YOURSELF]---
  863.     Music$ = "MBT180A4B-8B-8B-8B-2.G4A8F2"
  864.     PLAY "O2 X" + VARPTR$(Music$)
  865.     EXIT SUB
  866. 59104 '---[New User WALK RIGHT IN]---
  867.     Music1$ = "MBT180G4G4D2G8F+8F8E2A8B8"
  868.     Music2$ = "C8C+8D8C8"
  869.     Music3$ = "B4G2"
  870.     PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
  871.     EXIT SUB
  872. 59106 '---[Security Violation DRAGNET THEME]---
  873.      Music$ = "MBT120C2D8E-4C2.C2D8E-4C4G-2."
  874.      PLAY "O2 X" + VARPTR$(Music$)
  875.      EXIT SUB
  876. 59108 '---[Goodbye GOODBYE CHARLIE]---
  877.       Music$ = "MBT180B-2.G2.F4D2."
  878.       PLAY "O2 X" + VARPTR$(Music$)
  879.       EXIT SUB
  880. 59110 '---[Access Denied TAPS]---
  881.       Music1$ = "MBT90F8A16"
  882.       Music2$ = "C4."
  883.       Music3$ = "A4F4C2.C8C16F2"
  884.       PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
  885.       EXIT SUB
  886. 59112 '---[Download OOM PAH PAH]---
  887.        Music$ = "MBT180F4A4A4C4A4A4G4A4G4D2"
  888.        PLAY "O2 X" + VARPTR$(Music$)
  889.        EXIT SUB
  890. 59114 '---[Upload THANKS FOR THE MEMORIES]---
  891.        Music1$ = "MBT180C2."
  892.        Music2$ = "A8G8F4D2"
  893.        PLAY "O3 X" + VARPTR$(Music1$) + "O2 X" + VARPTR$(Music2$)
  894.        END SUB
  895. 59200 ' $SUBTITLE: 'TwoByteDate -- subroutine to put date in 2 bytes'
  896. ' $PAGE
  897. '
  898. '  NAME    -- TwoByteDate
  899. '
  900. '  INPUTS  --   PARAMETER     MEANING
  901. '                  Year       FOUR DIGIT YEAR (I.E. 1987)
  902. '                  WasMM      MONTH
  903. '                  WasDD      DAY
  904. '                Result$      LOCATION TO PLACE THE Result
  905. '
  906. '  OUTPUTS -- Result$       TWO BYTE COMPRESSED DATE FOR USE IN
  907. '                           A RANDOM RECORD
  908. '
  909. '  PURPOSE -- Compress a WasY,ZMsgPtr,WasD date into two characters
  910. '
  911.       SUB TwoByteDate (Year,WasMM,WasDD,Result$) STATIC
  912.       Result$ = CHR$(((Year - 1980) * 2) OR - ((WasMM AND 8) <> 0)) + _
  913.                 CHR$((WasMM AND NOT 8) * 32 + WasDD)
  914.       END SUB
  915. 59201 ' $SUBTITLE: 'PackDate -- subroutine to Compress STRING DATE'
  916. ' $PAGE
  917. '
  918. '  NAME    -- PackDate
  919. '
  920. '  INPUTS  --   PARAMETER     MEANING
  921. '                 Strng$    String Date (mm-dd-yyyy)
  922. '
  923. '  OUTPUTS --    Result$    TWO BYTE COMPRESSED DATE FOR USE IN
  924. '                                      A RANDOM RECORD
  925. '
  926. '  PURPOSE -- Compress an 8-character date into two characters
  927. '
  928.       SUB PackDate (Strng$,Result$) STATIC
  929.       IF LEN(Strng$) < 8 THEN _
  930.          EXIT SUB
  931.       Year = VAL(MID$(Strng$,7))
  932.       WasMM = VAL(Strng$)
  933.       WasDD = VAL(MID$(Strng$,4))
  934.       CALL TwoByteDate (Year,WasMM,WasDD,Result$)
  935.       END SUB
  936. 59202 ' $SUBTITLE: 'UnPackDate -- subroutine to UNCompress DATE'
  937. ' $PAGE
  938. '
  939. '  NAME    -- UnPackDate
  940. '
  941. '  INPUTS  --   PARAMETER      MEANING
  942. '             CompressedDate$ Date in 2 byte compressed form
  943. '
  944. '  OUTPUTS --     Year           Year of compressed date
  945. '                 WasMM          Month of compressed date
  946. '                 WasDD          Day of compressed date
  947. '             DisplayDate$       8 char display date (mm-dd-yyyy)
  948. '
  949. '  PURPOSE -- Uncompress a 2 char date to get Y,M,D & display
  950. '
  951.       SUB UnPackDate (CompressedDate$,Year,WasMM,WasDD,DisplayDate$) STATIC
  952.       CALL GetYMD (CompressedDate$,1,Year)
  953.       CALL GetYMD (CompressedDate$,2,WasMM)
  954.       CALL GetYMD (CompressedDate$,3,WasDD)
  955.       DisplayDate$ = RIGHT$("00" + MID$(STR$(WasMM),2),2) + _
  956.                       "-" + _
  957.                       RIGHT$("00" + MID$(STR$(WasDD),2),2) + _
  958.                       "-" + _
  959.                       RIGHT$(STR$(Year),2)
  960.       END SUB
  961. 59204 ' $SUBTITLE: 'GetYMD -- subroutine to unpack a two-byte date'
  962. ' $PAGE
  963. '
  964. '  NAME    -- GetYMD
  965. '
  966. '  INPUTS  --   PARAMETER     MEANING
  967. '                 TwoByte$    PACKED TWO-BYTE DATE FIELD
  968. '                   YMD       1 = YEAR
  969. '                             2 = MONTH
  970. '                             3 = DAY
  971. '                 Result      LOCATION TO PLACE THE Result
  972. '
  973. '  OUTPUTS -- Result        FOUR DIGIT Result OF UNPAKING THE DATE
  974. '
  975. '  PURPOSE -- Unpack a compressed two-byte date field
  976. '
  977.       SUB GetYMD (TwoByte$,YMD,Result) STATIC
  978.       ON YMD GOTO 59206,59210,59215
  979.       EXIT SUB
  980. 59206 Result = (ASC(TwoByte$)AND NOT 1) / 2 + 1980
  981.       EXIT SUB
  982. 59210 Result = FIX((ASC(MID$(TwoByte$,2)) / 32)) OR ((ASC(TwoByte$) AND 1) * 8)
  983.       EXIT SUB
  984. 59215 Result = ASC(MID$(TwoByte$,2)) AND NOT 224
  985.       END SUB
  986. 59300 ' $SUBTITLE: 'PersFile - processes requests for personal files'
  987. ' $PAGE
  988. '
  989. '  NAME    -- PersFile
  990. '
  991. '  INPUTS  --     PARAMETER           MEANING
  992. '                 PersonalCat$     CATEGORY IN DIR FOR CALLER
  993. '                 ZPersonalLen      # CHARS IN PERSONAL CATEGORY
  994. '  OUTPUTS -- NONE UP ZDnlds
  995. '
  996. '  PURPOSE -- Show caller what personal files have for downloading,
  997. '             verify and process requests for downloads
  998. '
  999.       SUB PersFile (PersonalCat$,DnldFlag) STATIC
  1000.       CALL FindIt (ZPersonalDir$)
  1001. 59302 IF NOT ZOK THEN _
  1002.          CALL QuickTPut1 ("No personal files available") : _
  1003.          ZLastIndex = 0 : _
  1004.          EXIT SUB
  1005.       GOSUB 59338
  1006.       IF LOF(2) < WasL THEN _
  1007.         ZOK = ZFalse : _
  1008.         GOTO 59302
  1009.       ZUserIn$(0) = ""
  1010.       MaxPrint = ZPageLength - 1
  1011.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  1012.       ZStopInterrupts = ZFalse
  1013.       IF Downloading THEN _
  1014.          Downloading = ZFalse : _
  1015.          PersIndex = DnldFlag : _
  1016.          DnldFlag = 0 : _
  1017.          GOTO 59306
  1018. 59303 CALL QuickTPut (ZEmphasizeOff$,0)
  1019.       ZOutTxt$ = "Download what: L)ist, * = new, or file(s)" + _
  1020.            ZPressEnterExpert$
  1021.       ZMacroMin = 99
  1022.       ZStackC = ZTrue
  1023.       CALL PopCmdStack
  1024.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1025.          ZLastIndex = 0 : _
  1026.          EXIT SUB
  1027. 59304 SelectedProtocol$ = ""
  1028.       IF ZLastIndex > 1 THEN _
  1029.          IF LEN(ZUserIn$(ZLastIndex)) = 1 THEN _
  1030.             SelectedProtocol$ = ZUserIn$(ZLastIndex) : _
  1031.             CALL AllCaps (SelectedProtocol$) : _
  1032.             IF INSTR(ZDefaultXfer$,SelectedProtocol$) = 0 THEN _
  1033.                SelectedProtocol$ = "" _
  1034.             ELSE ZLastIndex = ZLastIndex - 1
  1035.       IF LEN(ZUserIn$(ZAnsIndex)) > 1 THEN _
  1036.          GOTO 59330
  1037.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  1038.       ON INSTR("L*",ZUserIn$(ZAnsIndex)) GOTO 59305,59327
  1039.       GOTO 59303
  1040. 59305 PersIndex = LastRec
  1041.       WasL = ZFalse
  1042. 59306 IF PersIndex < 1 THEN _
  1043.          IF WasL THEN _
  1044.             GOTO 59303 _
  1045.          ELSE _
  1046.             ZOutTxt$ = "No files for you" : _
  1047.                  CALL QuickTPut1 (ZOutTxt$) : _
  1048.               GOTO 59303
  1049.       GET #2,PersIndex
  1050.       PersIndex = PersIndex - 1
  1051.       IF ZSysop THEN _
  1052.          GOTO 59320
  1053.       IF ASC(PrivateCat$) = 32 THEN _
  1054.          IF ZUserSecLevel < VAL(PrivateCat$) THEN _
  1055.             GOTO 59306 _
  1056.          ELSE GOTO 59308
  1057.       IF PersonalCat$ <> PrivateCat$ THEN _
  1058.          GOTO 59306
  1059. 59308 WasL = ZTrue
  1060.       FilName$ = ZPersonalDrvPath$ + _
  1061.                  LEFT$(PartToPrint$,12)
  1062. 59320 ZOutTxt$ = PartToPrint$
  1063.       IF PersonalStatus$ = "*" AND LEFT$(ZOutTxt$,1) <> " " THEN _
  1064.          MID$(ZOutTxt$, INSTR(ZOutTxt$," ")) = "*"
  1065.       CALL ColorDir (ZOutTxt$,"Y")
  1066.       IF ZLocalUser THEN _
  1067.          GOTO 59322
  1068.       CALL EofComm (Char)
  1069.       IF Char <> -1 THEN _
  1070.          GOTO 59323            ' comm port input
  1071. 59322 ZKeyboardStack$ = INKEY$
  1072. 59323 ZSubParm = 5
  1073.       CALL TPut
  1074.       IF ZRet THEN _
  1075.          GOTO 59303
  1076.       IF ZSubParm = -1 THEN _
  1077.          GOTO 59335
  1078. 59324 IF ZLinesPrinted <= MaxPrint THEN _
  1079.          GOTO 59306
  1080.       CALL TimeRemain (MinsRemaining)
  1081.       IF MinsRemaining <= 0 THEN _
  1082.          ZSubParm = -1 : _
  1083.          GOTO 59335
  1084.       CALL Carrier
  1085.       IF ZSubParm = -1 THEN _
  1086.          GOTO 59335
  1087.       IF ZNonStop THEN _
  1088.          GOTO 59306
  1089. 59325 IF PersIndex > 0 THEN _
  1090.          ZOutTxt$ = "MORE: [Y],N,C or download what (* = new)" _
  1091.       ELSE GOTO 59303
  1092.       ZNoAdvance = ZTrue
  1093.       ZMacroMin = 99
  1094.       ZStackC = ZTrue
  1095.       CALL PopCmdStack
  1096.       IF ZSubParm = -1 THEN _
  1097.          GOTO 59335
  1098.       ZNonStop = (ZNonStop OR INSTR(" Cc",ZUserIn$) > 1)
  1099.       IF PersIndex < 1 AND ZWasQ = 0 THEN _
  1100.          GOTO 59335
  1101.       CALL WipeLine (78)
  1102.       IF ZNo THEN _
  1103.          GOTO 59303
  1104.       IF LEN(ZUserIn$(ZAnsIndex)) > 2 THEN _
  1105.          GOTO 59304
  1106.       GOTO 59306
  1107. 59327 PersIndex = LastRec        ' handle new files
  1108.       ZLastIndex = 0
  1109.       WHILE PersIndex > 0 AND  ZLastIndex < UBOUND(ZUserIn$)
  1110.          GET 2,PersIndex
  1111.          IF PersonalCat$ <> PrivateCat$ THEN _
  1112.             GOTO 59329
  1113.          IF PersonalStatus$ <> "*" THEN _
  1114.             GOTO 59329
  1115.          ZLastIndex = ZLastIndex + 1
  1116.          WasI = ZLastIndex
  1117.          GOSUB 59336
  1118.          IF ZOK THEN _
  1119.             WasX$ = MID$(STR$(PersIndex),2) : _
  1120.             ZUserIn$(0) = ZUserIn$(0) + _
  1121.                     WasX$ + _
  1122.                     SPACE$(5 - LEN(WasX$)) _
  1123.          ELSE ZLastIndex = ZLastIndex - 1
  1124. 59329    PersIndex = PersIndex - 1
  1125.       WEND
  1126.       IF ZLastIndex = 0 THEN _
  1127.          ZOutTxt$ = "No new files for you" : _
  1128.          CALL QuickTPut1 (ZOutTxt$) : _
  1129.          GOTO 59303
  1130.       ZAnsIndex = 1
  1131.       GOTO 59332
  1132. 59330 WasI = ZAnsIndex              ' handle list of files
  1133.       WHILE WasI <= ZLastIndex
  1134.          ZOK = ZFalse
  1135.          WasJ = LastRec + 1
  1136.          CALL AllCaps (ZUserIn$(WasI))
  1137.          WasX = INSTR(ZUserIn$(WasI),".")
  1138.          IF WasX = 0 THEN _
  1139.             ZUserIn$(WasI) = ZUserIn$(WasI) + "." + ZDefaultExtension$ _
  1140.          ELSE IF WasX = LEN(ZUserIn$(WasI)) THEN _
  1141.                  ZUserIn$(WasI) = LEFT$(ZUserIn$(WasI),WasX-1)
  1142.          WHILE WasJ > 1 AND NOT ZOK
  1143.             WasJ = WasJ - 1
  1144.             GET #2,WasJ
  1145.             IF (PersonalCat$ = PrivateCat$ OR _
  1146.                (ASC(PrivateCat$) = 32 AND _
  1147.                 ZUserSecLevel => VAL(PrivateCat$))) THEN _
  1148.                 MID$(PartToPrint$,13,1) = " " : _
  1149.                    ZOK = (ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1))
  1150.          WEND
  1151.          IF ZOK THEN _
  1152.             GOSUB 59336 : _
  1153.             IF ZOK THEN _
  1154.                WasX$ = MID$(STR$(WasJ),2) : _
  1155.                ZUserIn$(0) = ZUserIn$(0) + _
  1156.                        WasX$ + _
  1157.                        SPACE$(5 - LEN(WasX$))
  1158.          IF NOT ZOK THEN _
  1159.             CALL QuickTPut1 (ZUserIn$(WasI) + " not found - omitted") : _
  1160.             FOR WasK = WasI + 1 TO ZLastIndex : _
  1161.                ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
  1162.             NEXT : _
  1163.             ZLastIndex = ZLastIndex - 1 : _
  1164.             WasI = WasI - 1
  1165.          WasI = WasI + 1
  1166.       WEND
  1167.       IF ZLastIndex = 0 THEN _
  1168.          GOTO 59303
  1169. 59332 DnldFlag = PersIndex          ' set protocol
  1170.       Downloading = ZTrue
  1171.       ZWasB = 1
  1172.       IF SelectedProtocol$ = "" THEN _
  1173.          IF ZPersonalProtocol$ <> " " THEN _
  1174.             SelectedProtocol$ = ZPersonalProtocol$
  1175.       IF SelectedProtocol$ <> "" THEN _
  1176.          ZLastIndex = ZLastIndex + 1 : _
  1177.          ZUserIn$(ZLastIndex) = SelectedProtocol$
  1178.       EXIT SUB
  1179. 59335 CLOSE 2
  1180.       EXIT SUB
  1181. 59336 ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1)
  1182.       CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK)
  1183.       IF ZOK THEN _
  1184.          ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _
  1185.       ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _
  1186.                       ((ZUserSecLevel < ZMinSecToView) OR _
  1187.                        NOT ZCanDnldFromUp),ZTrue,"D") : _
  1188.            GOSUB 59338
  1189.       RETURN
  1190. 59338 CLOSE 2
  1191.       WasL = 36 + ZMaxDescLen + ZPersonalLen
  1192.       IF ZShareIt THEN _
  1193.          OPEN ZPersonalDir$ FOR RANDOM SHARED AS #2 LEN=WasL _
  1194.       ELSE OPEN "R",2,ZPersonalDir$,WasL
  1195.       FIELD #2,33 + ZMaxDescLen AS PartToPrint$, _
  1196.                ZPersonalLen    AS PrivateCat$, _
  1197.                1               AS PersonalStatus$, _
  1198.                2               AS Filler$
  1199.       LastRec = LOF(2) / WasL
  1200.       RETURN
  1201.       END SUB
  1202. 59400 ' $SUBTITLE: 'LogPDown -- subroutine to record private downloads'
  1203. ' $PAGE
  1204. '
  1205. '  NAME    -- LogPDown
  1206. '
  1207. '  INPUTS  --   PARAMETER     MEANING
  1208. '
  1209. '  OUTPUTS --
  1210. '
  1211. '  PURPOSE -- Puts a "!" in place of an "*" in private directory
  1212. '             after downloaded
  1213. '
  1214.       SUB LogPDown (PrivateDnld,DwnIndex) STATIC
  1215.       IF NOT PrivateDnld THEN _
  1216.          EXIT SUB
  1217.       ZWasEN$ = ZPersonalDir$
  1218.       ZSubParm = 9
  1219.       CALL FileLock
  1220.       WasL = 36 + ZMaxDescLen + ZPersonalLen
  1221.       CALL OpenRand2 (ZWasEN$,WasL)
  1222.       IF ZErrCode > 0 THEN _
  1223.          EXIT SUB
  1224.       FIELD #2,WasL AS PersonalRec$
  1225.       L = LEN(ZUserIn$(0))
  1226.       FOR Temp = 1 TO ZDownFiles
  1227.          X = 5 * (DwnIndex - Temp) + 1
  1228.          IF X > 0 AND X < L THEN _
  1229.             ZWasA = VAL(MID$(ZUserIn$(0),X,5)) : _
  1230.             IF ZWasA > 0 THEN _
  1231.                GET #2,ZWasA : _
  1232.                MID$(PersonalRec$,WasL-2,1) = "!" : _
  1233.                PUT #2,ZWasA
  1234.       NEXT
  1235.       CALL UnLockAppend
  1236.       END SUB
  1237. 59450 ' $SUBTITLE: 'UserFace - handles programmable user interface'
  1238. ' $PAGE
  1239. '
  1240. '  NAME    --  UserFace
  1241. '
  1242. '  INPUTS  --  PARAMETER                   MEANING
  1243. '              GDefault$            GRAPHICS DEFAULT TO USE
  1244. '              ZCurPUI$             PUI TO USE
  1245. '              ZExpertUser          WHETHER CALL IN EXPERT MODE
  1246. '
  1247. '  OUTPUTS --  ZWasQ
  1248. '              ZUserIn$()
  1249. '              ZWasZ$
  1250. '
  1251. '  PURPOSE --  When sysop overrides RBBS-PC's default user
  1252. '              interface (provides a MAIN.PUT), this routine
  1253. '              reads in the table of specifications, presents
  1254. '              the sysop menu, presents the prompt, verifies
  1255. '              that a valid option has been picked, determines
  1256. '              whether the option is another PUI, and passes
  1257. '              back choices to be processed.
  1258. '
  1259.       SUB UserFace (GDefault$) STATIC
  1260. 59455 IF ZPrevPUI$ = ZCurPUI$ THEN _
  1261.          GOTO 59458
  1262. 59456 ZFileName$ = ZCurPUI$
  1263.       CALL Graphic (GDefault$,ZFileName$)
  1264.       IF NOT ZOK THEN _
  1265.          CALL UpdtCalr ("Missing menu " + ZCurPUI$,2) : _
  1266.          ZCurPUI$ = ZPrevPUI$ : _
  1267.          GOTO 59456
  1268.       CALL BreakFileName(ZFileName$,ZWasZ$,ZActiveMenu$,ZWasZ$,ZTrue)
  1269.       ZActiveMenu$ = LEFT$(ZActiveMenu$,1)
  1270.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  1271.       ZPrevPUI$ = ZCurPUI$
  1272.       LINE INPUT #2,ZFileName$
  1273.       LINE INPUT #2,Prompt$
  1274.       INPUT #2,ValidChoice$,ActualCommands$
  1275.       LINE INPUT #2,MenuChoice$
  1276.       LINE INPUT #2,MenuName$
  1277.       LINE INPUT #2,QuitCmd$
  1278.       LINE INPUT #2,QuitPrompt$
  1279.       LINE INPUT #2,QuitSubCmds$
  1280.       LINE INPUT #2,QuitMenuOpt$
  1281.       LINE INPUT #2,QuitMenus$
  1282.       CALL Graphic (GDefault$,ZFileName$)
  1283.       CALL BreakFileName (ZFileName$,MenuDrvPath$,WasX$,ZWasY$,ZTrue)
  1284.       MenuToDisplay$ = ZFileName$
  1285.       WasJ = INSTR(ZOrigCommands$,"?")
  1286.       IF WasJ < 1 THEN _
  1287.          WasX$ = "" _
  1288.       ELSE WasX$ = MID$(ZAllOpts$,WasJ,1)
  1289. 59458 IF ZExpertUser THEN _
  1290.          GOTO 59461
  1291. 59460 ZNonStop = (ZPageLength < 1)
  1292.       CALL BufFile (MenuToDisplay$,WasX)
  1293. 59461 MID$(ZLastCommand$,2,1) = " "
  1294.       ZOutTxt$ = Prompt$
  1295.       ZTurboKey = -ZTurboKeyUser
  1296.       CALL PopCmdStack
  1297.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1298.          EXIT SUB
  1299.       IF ZWasQ = 0 THEN _
  1300.          GOTO 59458
  1301. 59462 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1302.       CALL AllCaps (ZWasZ$)
  1303.       WasJ = INSTR(ValidChoice$,ZWasZ$)
  1304.       IF WasJ < 1 THEN _
  1305.          GOTO 59492
  1306.       ZWasZ$ = MID$(ActualCommands$,WasJ,1)
  1307.       ZUserIn$(ZAnsIndex) = ZWasZ$
  1308.       WasJ = INSTR(MenuChoice$,ZWasZ$)
  1309.       IF WasJ > 0 THEN _
  1310.          ZCurPUI$ = MID$(MenuName$,1 + (WasJ - 1) * 7,7) : _
  1311.          GOTO 59490
  1312.       IF ZWasZ$ = WasX$ THEN _
  1313.          GOTO 59460
  1314.       IF ZWasZ$ <> QuitCmd$ THEN _
  1315.          EXIT SUB
  1316. 59470 MID$(ZLastCommand$,2,1) = ZWasZ$
  1317.       ZOutTxt$ = QuitPrompt$
  1318.       ZTurboKey = -ZTurboKeyUser
  1319.       CALL PopCmdStack
  1320.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1321.          EXIT SUB
  1322.       IF ZWasQ = 0 THEN _
  1323.          ZUserIn$(1) = LEFT$(QuitSubCmds$,1) : _
  1324.          ZWasQ = 1
  1325. 59480 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1326.       CALL AllCaps (ZWasZ$)
  1327.       WasJ = INSTR(QuitSubCmds$,ZWasZ$)
  1328.       IF WasJ < 1 THEN _
  1329.          GOTO 59470
  1330.       WasJ = INSTR(QuitMenuOpt$,ZWasZ$)
  1331.       IF WasJ > 0 THEN _ 'quit to submenu
  1332.          ZCurPUI$ = MID$(QuitMenus$,1 + (WasJ - 1) * 7,7) : _
  1333.          GOTO 59490
  1334.       ZUserIn$(ZAnsIndex) = QuitCmd$ 'valid but not menu-send to RBBS
  1335.       EXIT SUB
  1336. 59490 CALL Remove (ZCurPUI$," ")
  1337.       ZCurPUI$ = MenuDrvPath$ + _
  1338.                      ZCurPUI$ + _
  1339.                      ".PUI"
  1340.       GOTO 59455
  1341. 59492 CALL QuickTPut1 ("No such option <" + ZWasZ$ + ">")
  1342.       Call FlushKeys
  1343.       GOTO 59460
  1344.       END SUB
  1345. 59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus'
  1346. ' $PAGE
  1347. '
  1348. '  NAME    -- SubMenu
  1349. '
  1350. '  INPUTS  --   PARAMETER     MEANING
  1351. '             PassedPrompt$   PROMPT TO DISPLAY
  1352. '             CurMenu$        NOVICE MENU TO DISPLAY
  1353. '             FrontOpt$       DRIVE/PATH/PREFIX OF FILE
  1354. '                             NEEDED FOR TYPED OPTION
  1355. '             BackOpt$        SUFFIX/EXTENSION OF FILE
  1356. '                             NEEDED WITH TYPED OPTION
  1357. '             ReturnOn$       LETTERS CALLING PROGRAM WANTS
  1358. '                             CONTROL ON
  1359. '             GRDefault$      GRAPHICS DEFAULT TO USE
  1360. '             VerifyInMenu    WHETHER VERIFY OPTION IS IN MENU
  1361. '             AllMenuOK       WHETHER CONTROL SHOULD RETURN
  1362. '                             WHEN IN MENU
  1363. '             ZAnsIndex       # OF COMMANDS IN TYPE AHEAD
  1364. '             RequireInMenu   WHETHER OPTION MUST BE IN MENU
  1365. '
  1366. '  OUTPUTS -- ZWasZ$              OPTION PICKED
  1367. '             ZFileName$      NAME OF FILE SUPPORTING OPTION
  1368. '
  1369. '
  1370. '  PURPOSE -- Handles menus - including conference, bulletins,
  1371. '             doors, questionnaires.  Supports sub-menus (i.e.
  1372. '             an option on the menu that invokes another menu)
  1373. '
  1374.       SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _
  1375.          BackOpt$,ReturnOn$,GRDefault$,PassedVerifyInMenu, _
  1376.          AllMenuOK,RequireInMenu,BackOpt2$,InMenu,ChkGraphic) STATIC
  1377. 59510 ZFileName$ = CurMenu$
  1378.       InMenu = ZTrue
  1379.       CALL BreakFileName (FrontOpt$,WasX$,FrontPre$,ZWasDF$,ZTrue)
  1380.       CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
  1381.       MenuFront$ = MenuDrv$ + LEFT$(WasX$,LEN(WasX$)-LEN(PreSuf$))
  1382.       IF CurMenu$ = LastSubMenu$ THEN _
  1383.          MenuFront$ = LEFT$(MenuFront$,LEN(MenuFront$)-1)
  1384.       CALL Graphic (GRDefault$,ZFileName$)
  1385.       CurMenuVer$ = ZFileName$
  1386.       ZStopInterrupts = ZFalse
  1387.       IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _
  1388.          GOTO 59520
  1389. 59515 CALL BufFile (CurMenuVer$,ZAnsIndex) 'show menu
  1390. 59520 ZOutTxt$ = PassedPrompt$            'get response
  1391.       CALL PopCmdStack
  1392.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  1393.          EXIT SUB
  1394. 59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1395.       CALL AllCaps (ZWasZ$)
  1396.       IF INSTR(ReturnOn$,ZWasZ$) THEN _  'check whether calling pgm wants
  1397.          EXIT SUB
  1398.       IF INSTR("LH?",ZWasZ$) THEN _       'check whether caller wants help
  1399.          GOTO 59515
  1400.       IF INSTR(ZWasZ$,".") > 0 THEN _
  1401.          GOTO 59532
  1402.       CALL BadFile (ZWasZ$,WasBF)
  1403.       IF WasBF > 1 THEN _
  1404.          GOTO 59532
  1405.       FPre$ = MenuFront$   ' check for sub-option
  1406.       PreSuf$ = "-"
  1407.       CALL BadFile (FPRE$ + ZWasZ$ + "-",WasBF)
  1408.       ZOK = ZFalse
  1409.       IF WasBF < 2 THEN _
  1410.          VerifyInMenu = ZFalse : _
  1411.          GOSUB 59538
  1412.       PreSuf$ = ""
  1413.       VerifyInMenu = PassedVerifyInMenu
  1414.       IF NOT ZOK THEN _
  1415.          FPre$ = FrontOpt$ : _    ' check standard option
  1416.          GOSUB 59538 : _
  1417.          IF NOT ZOK THEN _    ' check option where menu is
  1418.             FPre$ = MenuDrv$ + FrontPre$ : _
  1419.             IF FrontOpt$ <> FPre$ THEN _
  1420.                GOSUB 59538
  1421.       IF NewMenu THEN _
  1422.          NewMenu = ZFalse : _
  1423.          GOTO 59515
  1424.       IF ZOK THEN _
  1425.          EXIT SUB
  1426. 59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _
  1427.          ZWasZ$ = LEFT$(ZWasZ$,1) : _
  1428.          EXIT SUB
  1429.       GOSUB 59547
  1430.       GOTO 59515
  1431. 59538 FilName$ = FPre$ + ZWasZ$ + PreSuf$
  1432.       ZFileName$ = FilName$ + BackOpt$
  1433.       GOSUB 59543
  1434.       IF WasBF > 1 THEN _
  1435.          ZOK = ZFalse : _
  1436.          RETURN
  1437.       GOSUB 59542
  1438.       IF NOT ZOK THEN _
  1439.          IF BackOpt2$ <> "" THEN _
  1440.             ZFileName$ = FilName$ + _
  1441.                          BackOpt2$ : _
  1442.          GOSUB 59543 : _
  1443.          IF WasBF > 1 THEN _
  1444.             ZOK = ZFalse : _
  1445.             RETURN _
  1446.          ELSE GOSUB 59542
  1447.       IF ZOK THEN _
  1448.          CALL WordInFile (CurMenu$,ZWasZ$,InMenu) : _
  1449.          IF ZSysop OR InMenu OR (NOT RequireInMenu) THEN _
  1450.             RETURN _
  1451.          ELSE GOTO 59540
  1452.       IF (NOT VerifyInMenu) THEN _
  1453.          GOTO 59540
  1454.       CALL WordInFile (CurMenu$,ZWasZ$,InMenu)  'verify against menu itself
  1455.       IF InMenu THEN _
  1456.          IF AllMenuOK THEN _
  1457.             RETURN
  1458. 59540 WasX$ = FPre$ + _
  1459.            ZWasZ$ + PreSuf$ + _
  1460.            ".MNU" 'check whether option is a menu
  1461.       ZFileName$ = WasX$
  1462.       CALL Graphic (GRDefault$,ZFileName$)
  1463.       IF ZOK THEN _
  1464.          NewMenu = ZTrue : _
  1465.          CurMenuVer$ = ZFileName$ : _
  1466.          CurMenu$ = WasX$ : _
  1467.          CALL BreakFileName (FPre$ + ZWasZ$,MenuDrv$,WasX$,ZWasDF$,ZTrue) : _
  1468.          MenuFront$ = MenuDrv$ + WasX$ : _
  1469.          IF PreSuf$ = "-" THEN _
  1470.             LastSubMenu$ = CurMenu$
  1471.       RETURN
  1472. 59542 IF ChkGraphic THEN _
  1473.          CALL Graphic (GRDefault$,ZFileName$) _
  1474.       ELSE CALL FindIt (ZFileName$)
  1475.       RETURN
  1476. 59543 WasZ$ = ZWasZ$
  1477.       CALL BadName (WasBF,ZFalse)
  1478.       ZWasZ$ = WasZ$
  1479.       RETURN
  1480. 59547 CALL QuickTPut1 ("No such option " + ZWasZ$)
  1481.       ZLastIndex = 0
  1482.       IF VerifyInMenu AND InMenu AND NOT RequireInMenu THEN _
  1483.          CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _
  1484.                        CurMenu$ + " but not found",1)
  1485.       RETURN
  1486. 59548 END SUB
  1487. 59600 ' $SUBTITLE: 'SetEcho -- subroutine to reset who echoes'
  1488. ' $PAGE
  1489. '
  1490. '  NAME    -- SetEcho
  1491. '
  1492. '  INPUTS  --   PARAMETER     MEANING
  1493. '               NewEcho$   The new echo option
  1494. '               ZLocalUser
  1495. '
  1496. '  OUTPUTS -- ZRemoteEcho   Whether RBBS is to echo what a
  1497. '                           remote caller types
  1498. '
  1499. '  PURPOSE -- Resets who echos.  "R" is for RBBS to echo.
  1500. '             "I" is for intermediate host to echo.
  1501. '             "C" is for caller's communication pgm to echo.
  1502. '
  1503.       SUB SetEcho (NewEcho$) STATIC
  1504.       IF NewEcho$ = PrevEcho$ THEN _
  1505.          EXIT SUB
  1506.       IF NewEcho$ = "R" THEN _
  1507.          ZRemoteEcho = (NOT ZLocalUser) _
  1508.       ELSE ZRemoteEcho = ZFalse
  1509.       IF ZLocalUser THEN _
  1510.          GOTO 59602
  1511.       IF NewEcho$ = "I" THEN _
  1512.           IF ZFossil THEN _
  1513.              Bytes = LEN(ZHostEchoOn$) : _
  1514.              CALL FosWrite(ZComPort,Bytes,ZHostEchoOn$) : _
  1515.              GOTO 59602 _
  1516.           ELSE PRINT #3,ZHostEchoOn$; : _
  1517.                GOTO 59602
  1518.       IF PrevEcho$ = "I" THEN _
  1519.           IF ZFossil THEN _
  1520.              Bytes = LEN(ZHostEchoOff$) : _
  1521.              CALL FosWrite(ZComPort,Bytes,ZHostEchoOff$) _
  1522.           ELSE PRINT #3,ZHostEchoOff$;
  1523. 59602 PrevEcho$ = NewEcho$
  1524.       END SUB
  1525. 59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message'
  1526. ' $PAGE
  1527. '
  1528. '  NAME    -- MsgImport
  1529. '
  1530. '  INPUTS  --   PARAMETER     MEANING
  1531. '               MaxLines     MAXIMUM # OF LINES
  1532. '               MaxLen       MAXIMUM LENGTH OF A LINE
  1533. '               NumLines     NUMBER OF LINES ALREADY IN MESSAGE
  1534. '               LineAra$     ARRAY OF LINES IN MESSAGE
  1535. '
  1536. '  OUTPUTS --   NumLines
  1537. '               LineAra$
  1538. '
  1539. '  PURPOSE -- Allows local user to append a text file to
  1540. '             a message.   Will word wrap if needed.
  1541. '
  1542.       SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC
  1543.       IF NOT (ZLocalUser OR ZSysop) THEN _
  1544.          CALL QuickTPut1 ("Only for SysOps/local users") : _
  1545.          EXIT SUB
  1546. 59700 ZOutTxt$ = "Import what file" + ZPressEnter$
  1547.       CALL PopCmdStack
  1548.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1549.          EXIT SUB
  1550.       CALL FindIt (ZUserIn$(ZAnsIndex))
  1551.       IF NOT ZOK THEN _
  1552.          CALL QuickTPut1 (ZUserIn$(ZAnsIndex) + " not found") : _
  1553.          GOTO 59700
  1554.       WHILE NOT EOF(2) AND NumLines < MaxLines
  1555.          NumLines = NumLines + 1
  1556.          LINE INPUT #2,LineAra$(NumLines)
  1557.       WEND
  1558.       CLOSE 2
  1559.       CALL WordWrap (MaxLen,NumLines,LineAra$())
  1560.       END SUB
  1561. 59703 ' $SUBTITLE: 'WordWrap -- subroutine to wrap lines in a message'
  1562. ' $PAGE
  1563. '
  1564. '  NAME    -- WordWrap
  1565. '
  1566. '  INPUTS  --   PARAMETER     MEANING
  1567. '               MaxLen       MAXIMUM LENGTH OF A SINGLE LINE
  1568. '               NumLines     NUMBER OF LINES IN A MESSAGE
  1569. '               LineAra$     ALL THE LINES IN THE MESSAGE
  1570. '
  1571. '  OUTPUTS --   NumLines
  1572. '               LineAra$
  1573. '
  1574. '  PURPOSE -- Batch adjusts a message, wrapping lines if
  1575. '             needed.  Preserves paragraph structure.
  1576. '
  1577.       SUB WordWrap (MaxLen,NumLines,LineAra$(1)) STATIC
  1578.       WasJ = 1
  1579.       SplitOn = 1 + .4 * MaxLen
  1580.       WHILE WasJ <= NumLines
  1581.          ReFormatted = ZFalse
  1582. 59704    CALL TrimTrail (LineAra$(WasJ)," ")
  1583.          WasK = LEN(LineAra$(WasJ))
  1584.          IF WasK <= MaxLen THEN _
  1585.             GOTO 59705
  1586.          CALL FindLast (LineAra$(WasJ)," ",LastPos,HowMany)
  1587.          CALL AnyBut (LineAra$(WasJ),1,">",WasX)
  1588.          CALL AnyBut (LineAra$(WasJ+1),1,">",Temp)
  1589.          IF LEFT$(LineAra$(WasJ + 1),2) = "  " OR ((Temp > 0) AND WasX <> Temp) THEN _
  1590.             FOR WasK = NumLines TO WasJ + 1 STEP -1 : _
  1591.                LineAra$(WasK + 1) = LineAra$(WasK) : _
  1592.             NEXT : _
  1593.             NumLines = NumLines + 1 : _
  1594.             LineAra$(WasJ + 1) = ""
  1595.          IF WasX > 1 THEN _
  1596.             IF MID$(LineAra$(WasJ),WasX,1) = " " THEN _
  1597.                WasX = WasX + 1
  1598.          WasX$ = LEFT$(LineAra$(WasJ),WasX-1)
  1599.          IF LastPos < SplitOn THEN _
  1600.             LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),MaxLen) + MID$(LineAra$(WasJ + 1),WasX) : _
  1601.             LineAra$(WasJ) = LEFT$(LineAra$(WasJ),MaxLen - 1) + "-" _
  1602.          ELSE ZUserIn$ = LEFT$(" ", - (LEN(LineAra$(WasJ + 1)) > 0)) : _
  1603.               LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),LastPos + 1) + ZUserIn$ + MID$(LineAra$(WasJ + 1),WasX) : _
  1604.               LineAra$(WasJ) = LEFT$(LineAra$(WasJ),LastPos - 1)
  1605.          ReFormatted = ZTrue
  1606.          GOTO 59704
  1607. 59705    IF ReFormatted THEN _
  1608.             IF WasJ = NumLines THEN _
  1609.                NumLines = NumLines + 1
  1610.          WasJ = WasJ + 1
  1611.       WEND
  1612.       END SUB
  1613. 59760 ' $SUBTITLE: 'AnyBut -- subroutine to find where a word begins'
  1614. ' $PAGE
  1615. '
  1616. '  NAME    -- AnyBut
  1617. '
  1618. '  INPUTS  --   PARAMETER     MEANING
  1619. '               Strng$        STRING TO SEARCH FOR WORDS
  1620. '               Beg           BYTE POSITION IN Strng$ TO
  1621. '                             BEGIN SEARCHING
  1622. '               SkipChars$    CHARACTERS TO SKIP OVER WHEN
  1623. '                                SEARCHING
  1624. '
  1625. '  OUTPUTS --   WhereIs      BYTES POSITION IN Strng$ WHERE
  1626. '                             WORD BEGINS
  1627. '
  1628. '  PURPOSE -- Parser.   Finds where a "word" begins, where
  1629. '             any character will be accepted as the beginning of a
  1630. '             word except those listed in SKIP.CHAR$
  1631. '
  1632.       SUB AnyBut (Strng$, Beg, SkipChars$, WhereIs) STATIC
  1633.       WasX$ = Strng$ + _
  1634.            CHR$(0)
  1635.       WhereIs = Beg
  1636.       IF WhereIs < 1 THEN _
  1637.          WhereIs = 1
  1638.       WHILE INSTR(SkipChars$, MID$(WasX$, WhereIs, 1)) > 0
  1639.          WhereIs = WhereIs + 1
  1640.       WEND
  1641.       IF WhereIs > LEN(Strng$) THEN _
  1642.          WhereIs = 0
  1643.       END SUB
  1644. 59770 ' $SUBTITLE: 'FindEnd -- subroutine to find where a word ends'
  1645. ' $PAGE
  1646. '
  1647. '  NAME    -- FindEnd
  1648. '
  1649. '  INPUTS  --   PARAMETER     MEANING
  1650. '               Strng$        STRING TO SEARCH FOR WORDS
  1651. '               Beg          POSITION IN Strng$ TO BEGIN SEARCH
  1652. '               StopWith$    CHARACTERS THAT TERMINATE A WORD
  1653. '
  1654. '  OUTPUTS      WhereIs      POSITION IN Strng$ WHERE WORD ENDS
  1655. '                             (I.E. THE Last CHARACTER OF THE WORD)
  1656. '
  1657. '  PURPOSE -- Parser.   Finds where a "word" ends, where
  1658. '             any character will be counted as in a word
  1659. '             except for those in StopWith$ or when the end of
  1660. '             the string is found.
  1661. '
  1662.       SUB FindEnd (Strng$, Beg, StopWith$, WhereIs) STATIC
  1663.       ZWasB = Beg
  1664.       IF ZWasB < 1 THEN _
  1665.          ZWasB = 1
  1666.       IF ZWasB > LEN(Strng$) THEN _
  1667.          WasX$ = StopWith$ _
  1668.       ELSE WasX$ = MID$(Strng$, ZWasB) + _
  1669.                 StopWith$
  1670.       WasI = 1
  1671.       WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1672.       WHILE WasX = 0
  1673.          WasI = WasI + 1
  1674.          WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1675.       WEND
  1676.       WhereIs = WasI - 1 + ZWasB - 1
  1677.       END SUB
  1678. 59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list'
  1679. ' $PAGE
  1680. '
  1681. '  NAME    -- GetAll
  1682. '
  1683. '  INPUTS  --   PARAMETER     MEANING
  1684. '               LookIn$       NAME OF FILE TO SEARCH
  1685. '               DIR.EXT$      MAIN DIRECTORY EXTENSION TO USE
  1686. '               StartPos      Last POSITION USED IN ARRAY
  1687. '
  1688. '  OUTPUTS      StartPos     Last ELEMENT USED IN ARRAY
  1689. '               LoadInto$    ARRAY TO LOAD ELEMENTS Found
  1690. '
  1691. '  PURPOSE -- Creates a list (LoadInto$) of all directories
  1692. '             to be listed when ZWasA)ll is selected for a directory.
  1693. '             All uses config parm, which can be either a single
  1694. '             directory or list of directories (begin with "@").
  1695. '
  1696.       SUB GetAll (LoadInto$(1), StartPos) STATIC
  1697.       IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _
  1698.          StartPos = StartPos + 1 : _
  1699.          LoadInto$(StartPos) = ZMasterDirName$ : _
  1700.          EXIT SUB
  1701.       ZOK = ZFalse
  1702.       IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _
  1703.          CALL FindIt(MID$(ZMasterDirName$,2))
  1704.       IF NOT ZOK THEN _
  1705.          CALL QuickTPut1 ("No dirs defined for A)ll") : _
  1706.          EXIT SUB
  1707.       MaxLoad = UBOUND(LoadInto$, 1)
  1708.       StartSort = StartPos + 1
  1709.       WHILE NOT EOF(2) AND StartPos < MaxLoad
  1710.          LINE INPUT #2, ZOutTxt$
  1711.          StartPos = StartPos + 1
  1712.          LoadInto$(StartPos) = ZOutTxt$
  1713.       WEND
  1714.       CLOSE 2
  1715.       END SUB
  1716. 59800 ' $SUBTITLE: 'BadFileChar -- checks file for illegal char'
  1717. ' $PAGE
  1718. '
  1719. '  NAME    --  BadFileChar
  1720. '
  1721. '  INPUTS  --  PARAMETER         MEANING
  1722. '               FilName$         NAME OF FILE TO CHECK
  1723. '
  1724. '  OUTPUTS --  IsOK            WHETHER NAME OK
  1725. '
  1726. '  PURPOSE --  Part of test for file's existence.  If bad
  1727. '              character in name, can't exist.
  1728. '
  1729.       SUB BadFileChar (FilName$,IsOK) STATIC
  1730.       WasL = LEN(FilName$)
  1731.       IF WasL > 2 THEN _
  1732.          IF INSTR(3,FilName$,":") > 0 THEN _
  1733.             IsOK = ZFalse : _
  1734.             EXIT SUB
  1735.       WasX$ = FilName$ + "="
  1736.       WasI = 1
  1737.       WHILE INSTR("/[]|<>+=;, ?*",MID$(WasX$,WasI,1)) = 0 AND ASC(MID$(WasX$,WasI)) < 128
  1738.          WasI = WasI + 1
  1739.       WEND
  1740.       IsOK = WasI > WasL
  1741.       END SUB
  1742. '
  1743. 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
  1744. ' $PAGE
  1745. '
  1746. '  NAME    -- ConfMail
  1747. '
  1748. '  INPUTS  -- PARAMETER        MEANING
  1749. '         SKIP.CONFIRM         Whether to skip confirm of option
  1750. '         ZConfMailList$       File of user/message pairs to check
  1751. '         ZActiveUserFile$     Active user file (restored on exit)
  1752. '         ZActiveMessageFile$  Active msg file (restored)
  1753. '  OUTPUTS -- None
  1754. '
  1755. '  PURPOSE -- Quicking scans message header record to get
  1756. '             last msg # and user record to get whether any
  1757. '             new mail and last msg read, reports both, using
  1758. '             highlighting if new mail to caller.
  1759. '
  1760.       SUB ConfMail (MailCheckConfirm) STATIC
  1761.       SkipJoinUnjoin = ZNonStop
  1762.       IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
  1763.          CALL FindIt (ZConfMailList$) _
  1764.       ELSE ZOK = ZFalse
  1765.       IF NOT ZOK THEN _
  1766.          EXIT SUB
  1767.       IF PrevMailList$ <> ZConfMailList$ THEN _
  1768.          SkipParms = 0
  1769.       PrevMailList$ = ZConfMailList$
  1770.       IF MailCheckConfirm THEN _
  1771.          ZOutTxt$ = "Check conferences for mail ([Y],N)" : _
  1772.          ZTurboKey = -ZTurboKeyUser : _
  1773.          CALL PopCmdStack : _
  1774.          IF ZNo OR ZSubParm < 0 THEN _
  1775.             EXIT SUB
  1776.       CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
  1777.       CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
  1778.       CALL SkipLine (1)
  1779.       CALL QuickTPut1 ("Checking Message Bases...")
  1780.       AnyMail = ZFalse
  1781.       ZStopInterrupts = ZFalse
  1782.       WasA1$ = ZActiveUserFile$
  1783.       MsgFileSave$ = ZActiveMessageFile$
  1784.       TempIndivValue$ = ""
  1785.       UserFileIndexSave = ZUserFileIndex
  1786.       UserRecordHold$ = ZUserRecord$
  1787.       ZOK = ZTrue
  1788.       CALL ReadParms (ZWorkAra$(),1,SkipParms)
  1789.       IF SkipParms = 0 THEN _
  1790.          LogicalEOF$ = "" _
  1791.       ELSE LogicalEOF$ = ZWorkAra$(1)
  1792. 59852 IF NOT ZOK THEN _
  1793.          GOTO 59854 _
  1794.       ELSE IF EOF(2) THEN _
  1795.               IF LogicalEOF$ = "" OR SkipParms = 0 THEN _
  1796.                  GOTO 59854 _
  1797.               ELSE CALL FindIt (ZConfMailList$) : _
  1798.                    SkipParms = 0 : _
  1799.                    GOTO 59852
  1800.          CALL ReadAny
  1801.          ZActiveUserFile$ = ZOutTxt$
  1802.          CALL ReadAny
  1803.          IF ZErrCode > 0 THEN _
  1804.             GOTO 59854
  1805.          SkipParms = SkipParms + 2
  1806.          ZActiveMessageFile$ = ZOutTxt$
  1807.          CALL FindFile (ZActiveUserFile$,ZOK)
  1808.          IF NOT ZOK THEN _
  1809.             GOTO 59854
  1810.          CALL OpenUser (HighestUserRecord)
  1811.          FIELD 5, 128 AS ZUserRecord$
  1812.          CALL FindFile (ZActiveMessageFile$,ZOK)
  1813.          IF NOT ZOK THEN _
  1814.             GOTO 59854
  1815.          CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_
  1816.                         0,0,HighestUserRecord,_
  1817.                         Found,HoldUserFileIndex,ZWasSL)
  1818.          IF NOT Found THEN _
  1819.             GOTO 59853
  1820.          CALL OpenMsg
  1821.          FIELD 1, 128 AS ZMsgRec$
  1822.          GET 1,1
  1823.          AnyMail = ZTrue
  1824.          WasX = CVI(MID$(ZUserRecord$,57,2))
  1825.          WasX = (WasX AND 512) > 0
  1826.          CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse)
  1827.          InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$)
  1828.          IF InCur THEN _
  1829.             WasX = ZMailWaiting : _
  1830.             ZWasA = ZLastMsgRead _
  1831.          ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
  1832.          ZWasB = VAL(LEFT$(ZMsgRec$,8))
  1833.          WasZ = (ZWasB - ZWasA)
  1834.          IF WasZ < 0 THEN _
  1835.             ZWasA = 0 : _
  1836.             WasZ = ZWasB _
  1837.          ELSE IF WasZ = 0 THEN _
  1838.                  WasX = ZFalse
  1839.          ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
  1840.          ZWasSL = LEN(ZOutTxt$)
  1841.          ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$
  1842.          ZWasSL = LEN(CurPre$)
  1843.          IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
  1844.             Conf$ = "MAIN" _
  1845.          ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
  1846.          ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))
  1847.          IF WasX THEN _
  1848.             WasX$ = ZEmphasizeOn$ + "Some to you" + ZEmphasizeOff$ _
  1849.          ELSE WasX$ = "          "
  1850.          Temp$ = ""
  1851.          ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s) " + _
  1852.               WasX$ + Temp$
  1853.          ZSubParm = 5
  1854.          CALL TPut
  1855.          ZJumpSupported = ZFalse
  1856.          IF SkipJoinUnjoin THEN _
  1857.             CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
  1858.             GOTO 59853
  1859.          ZTurboKey = -ZTurboKeyUser
  1860.          CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse)
  1861.          IF ZNo THEN _
  1862.             GOTO 59854
  1863.          WasX$ = LEFT$(ZUserIn$(1),1)
  1864.          CALL AllCaps (WasX$)
  1865.          IF WasX$ = "J" THEN _
  1866.             ZLastIndex = ZWasQ : _
  1867.             ZHomeConf$ = Conf$ : _
  1868.             GOTO 59854
  1869.          IF WasX$ = "U" THEN _
  1870.             IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
  1871.                CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in") _
  1872.             ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
  1873.                  ZUserFileIndex = HoldUserFileIndex : _
  1874.                  ZSubParm = 6 : _
  1875.                  CALL FileLock : _
  1876.                  PUT 5, HoldUserFileIndex : _
  1877.                  ZSubParm = 8 : _
  1878.                  CALL FileLock : _
  1879.                  CALL QuickTPut1 ("Omitted you from " + Conf$)
  1880. 59853 IF ZActiveMessageFile$ = LogicalEOF$ THEN _
  1881.          GOTO 59854
  1882.       IF NOT ZRet THEN _
  1883.          GOTO 59852
  1884. 59854 ZActiveUserFile$ = WasA1$
  1885.       CALL OpenUser (HighestUserRecord)
  1886.       FIELD 5, 128 AS ZUserRecord$
  1887.       IF (NOT ZRet) AND NOT AnyMail THEN _
  1888.          CALL QuickTPut1 ("You have not joined any conferences")
  1889.       ZUserFileIndex = UserFileIndexSave
  1890.       LSET ZUserRecord$ = UserRecordHold$
  1891.       ZActiveMessageFile$ = MsgFileSave$
  1892.       CALL OpenMsg
  1893.       FIELD 1, 128 AS ZMsgRec$
  1894.       GET 1,1
  1895.       ZNonStop = (ZPageLength < 1)
  1896.       WasX$ = ZUserIn$(ZAnsIndex+1)
  1897.       CALL AllCaps (WasX$)
  1898.       ZAnsIndex = ZAnsIndex - (WasX$ = "C")
  1899.       SkipParms = -(NOT EOF(2))*SkipParms
  1900.       END SUB
  1901. 59858 ' $SUBTITLE: 'AskMore -- pauses when possible screen full'
  1902. ' $PAGE
  1903. '
  1904. '  NAME    -- AskMore
  1905. '
  1906. '  INPUTS  --   PARAMETER     MEANING
  1907. '               ExtraPrompt$  STRING TO ADD TO MORE PROMPT AT END
  1908. '               OverWrite     WHETHER TO WIPE AWAY PROMPT
  1909. '
  1910. '  OUTPUTS --   ZUserIn$()
  1911. '               ZNo
  1912. '
  1913. '  PURPOSE -- Determines whether need to pause if screen full.
  1914. '             And, if so, asks the appropriate question.  If non-
  1915. '             stop, at least check for carrier present.
  1916. '
  1917.       SUB AskMore (ExtraPrompt$, OverWrite, CheckLines,AbortIndex,CantInterrupt) STATIC
  1918.       ZNo = ZFalse
  1919.       IF CheckLines THEN _
  1920.          WasX = -ZDisplayAsUnit*ZUnitCount -(NOT ZDisplayAsUnit)*ZLinesPrinted : _
  1921.          IF WasX < ZPageLength OR (ZPageLength = 0) THEN _
  1922.             ZWasQ = 0 : _
  1923.             EXIT SUB
  1924.       IF ZOneStop THEN _
  1925.          ZOneStop = ZFalse : _
  1926.          ZNonStop = ZTrue : _
  1927.          GOTO 59860
  1928.       IF ZNonStop THEN _
  1929.          ZLinesPrinted = 0 : _
  1930.          CALL CheckCarrier : _
  1931.          IF ZKeyboardStack$ = "" AND ZCommPortStack$ = "" THEN _
  1932.             EXIT SUB _
  1933.          ELSE ZNonStop = ZFalse
  1934. 59860 CALL QuickTPut (ZEmphasizeOff$,0)
  1935.       IF CantInterrupt THEN _
  1936.          ZTurboKey = 2 : _
  1937.          ZForceKeyboard = ZTrue : _
  1938.          ZOutTxt$ = "Press any key to continue" _
  1939.       ELSE GOSUB 59870 : _
  1940.            ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser)
  1941.       WasX = LEN(ZOutTxt$) + 2
  1942.       ZNoAdvance = OverWrite
  1943.       ZSubParm = 1
  1944.       IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _
  1945.          ZTurboKey = -ZTurboKeyUser
  1946.       ZMacroMin = 2
  1947.       CALL TGet
  1948.       IF ZSubParm = -1 THEN _
  1949.         EXIT SUB
  1950.       ZTurboKey = ZFalse
  1951.       ZWasDF$ = ZUserIn$ (1)
  1952.       CALL AllCaps (ZWasDF$)
  1953.       WasI = INSTR(";C;A;",";"+ZWasDF$+";")
  1954.       IF WasI = 1 THEN _
  1955.          ZNonStop = ZTrue : _
  1956.          ZWasQ = 0
  1957.       CALL WipeLine (WasX + LEN(ZUserIn$))
  1958.       IF NOT ZHiLiteOff THEN _
  1959.          CALL QuickTPut (ZLastSmartColor$,0)
  1960.       IF CantInterrupt THEN _
  1961.          ZNo = ZFalse : _
  1962.          EXIT SUB
  1963.       IF WasI = 3 THEN _
  1964.          ZLastIndex = 0 : _
  1965.          AbortIndex = 32000
  1966.       IF ZNo THEN _
  1967.          ZKeyboardStack$ = "" : _
  1968.          ZCommPortStack$ = "" : _
  1969.          ZLastSmartColor$ = ""
  1970.       IF NOT ZJumpSupported THEN _
  1971.          EXIT SUB
  1972.       IF ZWasDF$ = "J" THEN _
  1973.          IF ZWasQ > 1 THEN _
  1974.             ZUserIn$ = ZUserIn$(2) : _
  1975.             GOTO 59866 _
  1976.          ELSE ZOutTxt$ = "Jump to what text" + ZPressEnterExpert$ : _
  1977.               CALL PopCmdStack : _
  1978.               IF ZWasQ = 0 THEN _
  1979.                  EXIT SUB _
  1980.               ELSE GOTO 59866
  1981.       IF ZWasDF$ <> "R" THEN _
  1982.          EXIT SUB
  1983.       ZUserIn$ = ZJumpLast$
  1984. 59866 ZJumpTo$ = ZUserIn$
  1985.       CALL AllCaps (ZJumpTo$)
  1986.       ZJumpSearching = ZTrue
  1987.       ZJumpLast$ = ZJumpTo$
  1988.       EXIT SUB
  1989. 59870 Temp$ = ""
  1990.       IF NOT ZJumpSupported THEN _
  1991.          RETURN
  1992.       IF ZJumpLast$ = "" THEN _
  1993.          Temp$ = LEFT$(",J)ump",2+4*(ZExpertUser+1)) _
  1994.       ELSE IF ZExpertUser THEN _
  1995.               Temp$ = ",J,R=" + ZJumpLast$ _
  1996.            ELSE Temp$ = ",J)ump,R)ejump=" + ZJumpLast$
  1997.       RETURN
  1998.       END SUB
  1999. 59880 ' $SUBTITLE: 'CompDate -- subroutine to compute elased days'
  2000. ' $PAGE
  2001. '
  2002. '  NAME    -- CompDate
  2003. '
  2004. '  INPUTS  --   PARAMETER     MEANING
  2005. '                   Year        YEAR
  2006. '                   WasMM       MONTH
  2007. '                   WasDD       DAY
  2008. '                 Result!    LOCATION TO PLACE THE Result
  2009. '
  2010. '  OUTPUTS -- Result!        COMPUTE COMPUTATIONAL DATE
  2011. '
  2012. '  PURPOSE -- Computes a computational date from YEAR, MONTH, DAY.
  2013. '             Results may be used to compute the number of elapsed
  2014. '             days between two dates.  You may pass a 2 or 4 digit
  2015. '             year, but for meaningful results, be consistent
  2016. '
  2017.       SUB CompDate (Year,WasMM,WasDD,Result!) STATIC
  2018.       IF WasMM < 1 OR WasMM > 12 THEN _
  2019.          WasMM = 1
  2020.       Result! = Year * 365.0 + _
  2021.                 INT((Year - 1) / 4) + _
  2022.                 (WasMM - 1) * 28 + _
  2023.                 VAL(MID$("000303060811131619212426",(WasMM - 1) * 2 + 1,2)) - _
  2024.                 ((WasMM > 2) AND ((Year MOD 4) = 0)) + _
  2025.                 WasDD
  2026.       END SUB
  2027. 59890 ' $SUBTITLE: 'ExpireDate -- subroutine to display expiration date'
  2028. ' $PAGE
  2029. '
  2030. '  NAME    -- ExpireDate
  2031. '
  2032. '  INPUTS  --   PARAMETER           MEANING
  2033. '             RegDate!    COMPUTATIONAL REGISTRATION DATE
  2034. '             RegPeriod   DAYS IN REGISTRATION PERIOD
  2035. '
  2036. '  OUTPUTS -- ExpDate$             DISPLAYABLE EXPIRATION DATE
  2037. '
  2038. '  PURPOSE -- Computes/creates a displayable registration
  2039. '             expiration date using registration date and days in
  2040. '             registration period.
  2041. '
  2042.       SUB ExpireDate (RegDate!,RegPeriod,ExpDate$) STATIC
  2043.       ExpDate! = RegDate! + RegPeriod
  2044.       ExpireYear = INT((ExpDate! - ExpDate! / 1461) / 365)
  2045.       ExpireDay = ExpDate! - (ExpireYear * 365.0 + INT((ExpireYear -1)/4))
  2046.       ExpireMonth = -((ExpireYear MOD 4)<>0) * _
  2047.                       (1 - (ExpireDay > 31) - (ExpireDay > 59) - _
  2048.                       (ExpireDay > 90) - (ExpireDay >120) - _
  2049.                       (ExpireDay > 151) - (ExpireDay > 181) - _
  2050.                       (ExpireDay > 212) - (ExpireDay > 243) - _
  2051.                       (ExpireDay > 273) - (ExpireDay > 304) - _
  2052.                       (ExpireDay > 334)) - ((ExpireYear MOD 4) = 0) * _
  2053.                       (1 - (ExpireDay > 31) - (ExpireDay > 60) - _
  2054.                       (ExpireDay > 91) - (ExpireDay >121) - _
  2055.                       (ExpireDay > 152) - (ExpireDay > 182) - _
  2056.                       (ExpireDay > 213) - (ExpireDay > 243) - _
  2057.                       (ExpireDay > 274) - (ExpireDay > 305) - _
  2058.                       (ExpireDay > 335))
  2059.       ExpireDay = (ExpireDay - ((ExpireMonth - 1) * 28 + _
  2060.          VAL(MID$("000303060811131619212426",(ExpireMonth -1) * 2 + 1,2)))) + _
  2061.          ((ExpireMonth > 2) AND ((ExpireYear MOD 4) = 0))
  2062.       ExpDate$ = RIGHT$("0" + MID$(STR$(ExpireMonth),2),2) + _
  2063.                   "/" + _
  2064.                   RIGHT$("0" + MID$(STR$(ExpireDay),2),2) + _
  2065.                   "/" + _
  2066.                   RIGHT$(STR$(ExpireYear),2)
  2067.       END SUB
  2068. 59920 ' $SUBTITLE: 'ColorDir - builds a color FMS directory string'
  2069. ' $PAGE
  2070. '
  2071. '  NAME    --  ColorDir
  2072. '
  2073. '  INPUTS  --  PARAMETER                   MEANING
  2074. '               Strng$              String to alter
  2075. '               FMSDir$            "Y" FOR FMS DIR
  2076. '                                  "N" FOR PERSONAL Download
  2077. '
  2078.       SUB ColorDir (Strng$,FMSDir$) STATIC
  2079.       IF ZWasGR < 2 THEN _
  2080.          EXIT SUB
  2081.       IF FMSDir$ = "N" THEN _
  2082.          GOTO 59921
  2083. '
  2084. ' INSERT COLOR FOR FILENAME
  2085. '
  2086.       ON INSTR("\ *",LEFT$(Strng$,1)) GOTO 59924,59922,59923
  2087. 59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,10) + _
  2088.                ZDR3$ + MID$(Strng$,24,10) + ZDR4$ + MID$(Strng$,34,ZMaxDescLen)
  2089.       EXIT SUB
  2090. 59922 Strng$ = ZDR4$ + Strng$
  2091.       EXIT SUB
  2092. 59923 Strng$ = ZEmphasizeOff$ + Strng$
  2093. 59924 END SUB
  2094. 59930 ' $SUBTITLE: 'CheckColor - highlights based on search string'
  2095. ' $PAGE
  2096. '
  2097. '  NAME    --  CheckColor
  2098. '
  2099. '  INPUTS  --  PARAMETER                   MEANING
  2100. '              LookFor$           String that triggers highlight
  2101. '              LookIn$            String being searched
  2102. '              EndColor$          Terminating color
  2103. '
  2104. '  OUTPUTS --  Strng$              Revised string
  2105. '
  2106. '  PURPOSE --  Adds highlighting to a string within a string.
  2107. '              Respects previous colorization.
  2108.       SUB CheckColor (LookIn$,LookFor$,PassedEndColor$) STATIC
  2109.       IF LookFor$ = "" THEN _
  2110.          EXIT SUB
  2111.       WasX$ = LookIn$
  2112.       CALL AllCaps (WasX$)
  2113.       StartColor = INSTR(WasX$,LookFor$)
  2114.       IF StartColor < 1 THEN _
  2115.          EXIT SUB
  2116.       EndColor$ = PassedEndColor$
  2117.       IF EndColor$ = "" THEN _
  2118.          EndColor$ = ZEmphasizeOff$ : _
  2119.          CALL FindLast (LEFT$(LookIn$,StartColor-1),ZEscape$,WhereFound,WasJ) : _
  2120.          IF WhereFound > 0 THEN _
  2121.             WasJ = INSTR(WhereFound,LookIn$,"m") : _
  2122.             IF WasJ > 0 THEN _
  2123.                EndColor$ = MID$(LookIn$,WhereFound,WasJ-WhereFound+1)
  2124.       CALL Bracket (LookIn$,StartColor,StartColor + LEN(LookFor$)-1,ZEmphasizeOn$,EndColor$)
  2125.       END SUB
  2126. 59934 ' $SUBTITLE: 'SetHiLite - subroutine to reset highlight preference'
  2127. ' $PAGE
  2128. '
  2129. '  NAME    --  SetHiLite
  2130. '
  2131. '  INPUTS  --  PARAMETER                   MEANING
  2132. '              SetTo              New value (True or False)
  2133. '              ZEmphasizeOnDef$   String turns emphasize on
  2134. '              ZEmphasizeOffDef$  String turns emphasize off
  2135. '
  2136. '  OUTPUTS --  ZHiLiteOff       Callers preference on Hilite
  2137. '              ZEmphasizeOn$       String to use for emphasis
  2138. '              ZEmphasizeOff$      String to use after emphasis
  2139. '
  2140.       SUB SetHiLite (SetTo) STATIC
  2141.       ZHiLiteOff = (ZEmphasizeOnDef$ <> "" AND SetTo)
  2142.       IF ZHiLiteOff THEN _
  2143.          ZEmphasizeOn$ = "" : _
  2144.          ZEmphasizeOff$ = "" : _
  2145.          ZFG1$ = "" : _
  2146.          ZFG2$ = "" : _
  2147.          ZFG3$ = "" : _
  2148.          ZFG4$ = "" _
  2149.       ELSE ZEmphasizeOn$ = ZEmphasizeOnDef$ : _
  2150.            ZFG1$ = ZFG1Def$ : _
  2151.            ZFG2$ = ZFG2Def$ : _
  2152.            ZFG3$ = ZFG3Def$ : _
  2153.            ZFG4$ = ZFG4Def$
  2154.       END SUB
  2155. 59940 ' $SUBTITLE: 'ColorPrompt - subroutine to colorize prompts'
  2156. ' $PAGE
  2157. '
  2158. '  NAME    --  ColorPrompt
  2159. '
  2160. '  INPUTS  --  PARAMETER                   MEANING
  2161. '              Strng$              String to colorize
  2162. '              ZHiLiteOff          Whether highlighting is off
  2163. '              ZEmphasizeOn$       String to use for emphasis
  2164. '              ZEmphasizeOff$      String to use after emphasis
  2165. '
  2166. '  OUTPUTS --  Strng$              Colorized string
  2167. '
  2168. '  PURPOSE -- colorizes a string based on sysop settings
  2169. '             and the string.
  2170. '                        [...] is the default - put in emphasis
  2171. '                        <...> options to type - put in ZFG4$
  2172. '                        and first two preceeding words use ZFG1$ and ZFG2$
  2173. '                        options identified on right by ) and on
  2174. '                        left by space or comma - put in ZFG4$
  2175. '
  2176.       SUB ColorPrompt (Strng$) STATIC
  2177.       IF ZHiLiteOff THEN _
  2178.          EXIT SUB
  2179.       AlreadyColorized = (INSTR(Strng$,ZEscape$) > 0)
  2180.       WasX = INSTR(Strng$,"<")
  2181.       IF WasX > 0 THEN _
  2182.          GOTO 59943
  2183.       WasX = INSTR(Strng$,"[")   ' highlight default
  2184.       IF WasX > 0 THEN _
  2185.          WasY = INSTR(WasX,Strng$,"]") : _
  2186.          IF WasY > 0 THEN _
  2187.             CALL FindLast (LEFT$(Strng$,WasY),"[",WasX,Temp) : _
  2188.             CALL Bracket (Strng$,WasX,WasY,ZEmphasizeOn$,ZEmphasizeOff$)
  2189.       IF AlreadyColorized THEN _
  2190.          EXIT SUB
  2191.       WasX = INSTR(Strng$,"<")
  2192.       IF WasX < 1 THEN _
  2193.          GOTO 59945
  2194. 59943 WasY = INSTR(WasX,Strng$,">")
  2195.       IF WasY < 1 THEN _
  2196.          GOTO 59945
  2197.       CALL Bracket (Strng$,WasX,WasY,ZFG4$,ZEmphasizeOff$)
  2198.       WasY = INSTR(Strng$," ")
  2199.       IF WasY > 1 AND WasY < WasX THEN _
  2200.          Strng$ = ZFG1$ + Strng$ : _
  2201.          WasZ = INSTR(WasY+1,Strng$," ") : _
  2202.          IF WasZ > 1 AND WasZ < WasX+LEN(ZFG1$) THEN _
  2203.             Strng$ = LEFT$(Strng$,WasZ) + ZFG2Def$ + MID$(Strng$,WasZ+1)
  2204.       EXIT SUB
  2205. 59945 WasX = 1
  2206.       DidInsert = ZFalse
  2207.       WasL = LEN(ZFG4$)
  2208. 59950 WasY = INSTR (WasX,Strng$,")")  ' x: where command begins, y: terminating pos
  2209.       WasZ = INSTR (WasX,Strng$,",")
  2210.       IF WasY = 0 OR (WasZ > 0 AND WasZ < WasY) THEN _
  2211.          WasY = WasZ
  2212.       WasK = LEN(Strng$)
  2213.       IF WasX > WasK THEN _
  2214.          EXIT SUB
  2215.       IF WasY < 1 THEN _
  2216.          IF NOT DidInsert THEN _
  2217.             EXIT SUB _
  2218.          ELSE WasY = WasK+1
  2219.       WasZ = WasY - 1
  2220.       WHILE WasZ > 0    ' got terminating pos: find beginning
  2221.          IF INSTR(ZOptionEnd$,MID$(Strng$,WasZ,1)) > 0 THEN _
  2222.             WasX = WasZ + 1 : _
  2223.             WasZ = 0
  2224.          WasZ = WasZ - 1
  2225.       WEND
  2226.       IF WasY-WasX < 3 THEN _     ' exclude commands too long
  2227.          CmndString$ = MID$(Strng$,WasX,WasY-WasX) : _
  2228.          WasX$ = CmndString$ : _
  2229.          CALL AllCaps (CmndString$) : _
  2230.          IF WasX$ = CmndString$ THEN _  ' exclude lower case
  2231.             DidInsert = ZTrue : _
  2232.             CALL Bracket (Strng$,WasX,WasY-1,ZFG4$,ZEmphasizeOff$) : _
  2233.             WasY = WasY + WasL
  2234.       WasX = WasY + 1
  2235.       GOTO 59950
  2236.       END SUB
  2237. 59960 ' $SUBTITLE: 'Bracket - Inserts strings around a string'
  2238. ' $PAGE
  2239. '
  2240. '  NAME    --  Bracket
  2241. '
  2242. '  INPUTS  --  PARAMETER                   MEANING
  2243. '              Strng$              Insert in this string
  2244. '              B4Here              Insert 1st before this pos
  2245. '              AfterHere           Insert 2nd after this pos
  2246. '              B4String$           String to insert before
  2247. '              AfterString$        String to insert after
  2248. '
  2249. '  OUTPUTS --  Strng$
  2250. '
  2251. '  PURPOSE -- Primarily for colorization
  2252. '
  2253.       SUB Bracket (Strng$,B4Here,AfterHere,B4String$,AfterString$) STATIC
  2254.       Strng$ = LEFT$(Strng$,B4Here-1) + _
  2255.                B4String$ + _
  2256.                MID$(Strng$,B4Here,AfterHere-B4Here+1) + _
  2257.                AfterString$ + _
  2258.                RIGHT$(Strng$,LEN(Strng$) - AfterHere)
  2259.       END SUB
  2260. 59965 ' $SUBTITLE: 'UserColor - lets user set color for normal text'
  2261. ' $PAGE
  2262. '
  2263. '  NAME    --  UserColor
  2264. '
  2265. '  INPUTS  --  PARAMETER                   MEANING
  2266. '              ZEmphasizeOff$            Normal text color
  2267. '
  2268. '  OUTPUTS --  ZEmphasizeOff$            New text color
  2269. '              ZBoldText$                Whether bold (0 not, 1 bold)
  2270. '              ZUserTextColor            ANSI Color selected
  2271. '
  2272. '  PURPOSE --  Lets caller select desired color and whether bold.
  2273. '
  2274.       SUB UserColor STATIC
  2275.       IF ZHiLiteOff THEN _
  2276.          EXIT SUB
  2277. 59970 CALL QuickTPut (ZEmphasizeOff$,0)
  2278.       ZOutTxt$ = "Make text R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite" + ZPressEnterExpert$
  2279.       GOSUB 59973
  2280.       IF ZWasQ = 0 THEN _
  2281.          ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  2282.              ";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _
  2283.          EXIT SUB
  2284.       CALL AllCaps (ZUserIn$)
  2285.       WasX = INSTR("RGYBPCW",ZUserIn$)
  2286.       IF WasX = 0 THEN _
  2287.          GOTO 59970
  2288.       ZUserTextColor = 30 + WasX
  2289.       ZOutTxt$ = "Make text BRIGHT (Y,[N])"
  2290.       GOSUB 59973
  2291.       ZBoldText$ = CHR$(48 - ZYes)
  2292.       ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  2293.       GOTO 59970
  2294. 59973 ZSubParm = 1
  2295.       ZTurboKey = -ZTurboKeyUser
  2296.       CALL TGet
  2297.       IF ZSubParm = -1 THEN _
  2298.          EXIT SUB
  2299.       RETURN
  2300.       END SUB
  2301. 59980 ' $SUBTITLE: 'SetGraphic - Sets user graphic preference'
  2302. ' $PAGE
  2303. '
  2304. '  NAME    --  SetGraphic
  2305. '
  2306. '  INPUTS  --  PARAMETER                   MEANING
  2307. '              GraphicsNumber        0=None, 1=Ascii, 2=color
  2308. '
  2309. '  OUTPUTS --  ZWasGR                Shared var - set to
  2310. '                                    graphics.number
  2311. '              GraphicsLetter$       What add to file name to
  2312. '                                see if got graphics file ver
  2313. '
  2314. '  PURPOSE --  Sets file graphics preference
  2315. '
  2316.       SUB SetGraphic (GraphicsNumber,GraphicsLetter$) STATIC
  2317.       ZWasGR = GraphicsNumber
  2318.       IF ZWasGR = 2 THEN _
  2319.          ZDR1$ = ZFG1Def$ : _
  2320.          ZDR2$ = ZFG2Def$ : _
  2321.          ZDR3$ = ZFG3Def$ : _
  2322.          ZDR4$ = ZFG4Def$ _
  2323.       ELSE ZDR1$ = "" : _
  2324.            ZDR2$ = "" : _
  2325.            ZDR3$ = "" : _
  2326.            ZDR4$ = ""
  2327.       GraphicsLetter$ = MID$(" GC",ZWasGR+1, - (ZWasGR > 0))
  2328.       END SUB
  2329. 60000 ' $SUBTITLE: 'EofComm - Determines whether input in comm port buffer'
  2330. ' $PAGE
  2331. '
  2332. '  NAME    --  EofComm
  2333. '
  2334. '  INPUTS  --  PARAMETER                   MEANING
  2335. '               ZFossil              Whether fossil driver used
  2336. '               ZComPort            Comm port # in use
  2337. '
  2338. '  OUTPUTS --  NoChars           -1 (True) if no chars in buffer.
  2339. '                                   Anything else means has char.
  2340. '
  2341. '  PURPOSE -- Query comm port to see if input waiting
  2342. '
  2343.       SUB EofComm (NoChars) STATIC
  2344.       IF ZFossil THEN _
  2345.          CALL FosReadAhead(ZComPort,NoChars) _
  2346.       ELSE NoChars = EOF(3)
  2347.       END SUB
  2348. 60100 ' $SUBTITLE: 'GlobalSrchRepl - Global search and replace'
  2349. ' $PAGE
  2350. '
  2351. '  NAME    --  GlobalSrchRepl
  2352. '
  2353. '  INPUTS  --  PARAMETER                   MEANING
  2354. '              Strng$              String to edit
  2355. '              LookFor$           String to look for
  2356. '              ReplaceBy$         String to replace by
  2357. '
  2358. '  OUTPUTS --  Strng$              Edited string
  2359. '
  2360. '  PURPOSE --  Replaces every occurence of LookFor$ that
  2361. '                         is in Strng$ by ReplaceBy$
  2362. '
  2363.       SUB GlobalSrchRepl (Strng$,LookFor$,ReplaceBy$,OverStrike) STATIC
  2364.       IF LookFor$ = "" THEN _
  2365.          EXIT SUB
  2366.       WasX = 1
  2367.       WasL = LEN(ReplaceBy$)
  2368.       ZMsgPtr = LEN(LookFor$)
  2369. 60102 WasY = INSTR(WasX,Strng$,LookFor$)
  2370.       IF WasY < 1 THEN _
  2371.          EXIT SUB
  2372.       IF OverStrike THEN _
  2373.          MID$(Strng$,WasY) = ReplaceBy$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  2374.       ELSE Strng$ = LEFT$(Strng$,WasY-1) + _
  2375.                     ReplaceBy$ + _
  2376.                     RIGHT$(Strng$,LEN(Strng$)-WasY+1-ZMsgPtr)
  2377.       WasX = WasY + WasL
  2378.       IF WasX > LEN(Strng$) THEN _
  2379.          EXIT SUB
  2380.       GOTO 60102
  2381.       END SUB
  2382. 60130 ' $SUBTITLE: 'MetaGSR -- Meta Global search and replace'
  2383. ' $PAGE
  2384. '
  2385. '  NAME    --  MetaGSR
  2386. '
  2387. '  INPUTS  --  PARAMETER               MEANING
  2388. '              Strng$              String to edit
  2389. '
  2390. '  OUTPUTS --  Strng$              Edited string
  2391. '
  2392. '  PURPOSE --  Global search and replace for meta variables
  2393. '
  2394.       SUB MetaGSR (Strng$,OverStrike) STATIC
  2395.       WasY = 1
  2396. 60131 IF WasY > LEN(Strng$) THEN _
  2397.          EXIT SUB
  2398.       WasX = INSTR(WasY,Strng$,"[")
  2399.       IF WasX = 0 THEN _
  2400.          EXIT SUB
  2401.       WasY = INSTR(WasX,Strng$,"]")
  2402.       IF WasY = 0 THEN _
  2403.          EXIT SUB
  2404.       ZMsgPtr = WasY-WasX+1
  2405.       Temp = WasY-WasX-1
  2406.       CALL CheckInt(MID$(Strng$,WasX+1,Temp))
  2407.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR (ZTestedIntValue > ZMaxWorkVar) THEN _
  2408.          GOTO 60135
  2409.       IF ((ZTestedIntValue < 10) AND (Temp = 1)) OR ((ZTestedIntValue > 9) AND (Temp = 2)) THEN _
  2410.          GOTO 60132
  2411.       WasY = WasX + 1
  2412.       GOTO 60131
  2413. 60132 WorkHold$ = ZGSRAra$(ZTestedIntValue)
  2414.       IF WasY = LEN(Strng$) THEN _
  2415.          GOTO 60151
  2416.       IF MID$(Strng$,WasY+1,1) <> "(" THEN _
  2417.          GOTO 60151
  2418.       WasI = INSTR(WasY+1,Strng$,")")
  2419.       IF WasI = 0 THEN _
  2420.          GOTO 60151
  2421.       WasJ = INSTR(WasY+1,Strng$,":")
  2422.       IF WasJ > WasI THEN _
  2423.          GOTO 60151
  2424.       CALL CheckInt (MID$(Strng$,WasY+2))
  2425.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  2426.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2427.             GOTO 60151
  2428.       WasY = WasI
  2429.       ZMsgPtr = WasI-WasX+1
  2430.       StartSub = ZTestedIntValue
  2431.       CALL CheckInt (MID$(Strng$,WasJ+1))
  2432.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR _
  2433.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2434.             GOTO 60151
  2435.       LenSub = ZTestedIntValue
  2436.       WorkHold$ = MID$(WorkHold$,StartSub,LenSub)
  2437.       GOTO 60151
  2438. 60135 MetaVal$ = MID$(Strng$,WasX+1,WasY-WasX-1)
  2439.       WasI = INSTR("      BAUD  PORT  PORT# PARITYPROTO NODE  FILE  ",MetaVal$)
  2440.       IF WasI = 0 OR LEN(MetaVal$) < 4 THEN _
  2441.          WasY = WasX + 1 : _
  2442.          GOTO 60131
  2443.       WasJ = (WasI-1)\6 + 1
  2444.       WasK = (WasI+4)\6 + 1
  2445.       IF WasK > WasJ THEN _
  2446.          EXIT SUB
  2447.       ON WasJ GOTO 60155, _
  2448.                 60137, _
  2449.                 60139, _
  2450.                 60141, _
  2451.                 60143, _
  2452.                 60145, _
  2453.                 60147, _
  2454.                 60149, _
  2455.                 60151
  2456. 60137 WorkHold$ = ZTalkToModemAt$
  2457.       GOTO 60151
  2458. 60139 WorkHold$ = ZComPort$
  2459.       GOTO 60151
  2460. 60141 WorkHold$ = MID$(ZComPort$,4)
  2461.       GOTO 60151
  2462. 60143 WorkHold$ = MID$(ZBaudParity$,INSTR(ZBaudParity$,",")+1,1)
  2463.       GOTO 60151
  2464. 60145 WorkHold$ = ZWasFT$
  2465.       GOTO 60151
  2466. 60147 WorkHold$ = ZNodeID$
  2467.       GOTO 60151
  2468. 60149 IF ZBatchTransfer THEN _
  2469.          WorkHold$ = "@" + ZNodeWorkFile$ _
  2470.       ELSE WorkHold$ = ZFileName$
  2471.       GOTO 60151
  2472. 60151 WasL = LEN(WorkHold$)
  2473.       IF OverStrike THEN _
  2474.          MID$(Strng$,WasX) = WorkHold$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  2475.       ELSE Strng$ = LEFT$(Strng$,WasX-1) + WorkHold$ + RIGHT$(Strng$,LEN(Strng$)-WasY)
  2476.       WasY = 1 ' WasY = WasX + WasL
  2477.       GOTO 60131
  2478. 60155 WasY = WasY + 1
  2479.       GOTO 60131
  2480.       END SUB
  2481. 60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features'
  2482. ' $PAGE
  2483. '
  2484. '  NAME    --  TimeLock  (written by Doug Azzarito)
  2485. '
  2486. '  INPUTS  --  PARAMETER                   MEANING
  2487. '              ZTimeLockSet               SECONDS/SESSION TO LOCK
  2488. '
  2489. '  OUTPUTS --  ZSubParm     -1 if feature is LOCKED
  2490. '
  2491. '  PURPOSE -- Check elapsed time for lock duration
  2492. '
  2493.       SUB TimeLock STATIC
  2494.       CALL TimeRemain(MinsRemaining)
  2495.       IF ZSecsUsedSession! >= ZTimeLockSet THEN _
  2496.          ZOK = ZTrue : _
  2497.          EXIT SUB
  2498.       ZOutTxt$ = ZFirstName$
  2499.       CALL NameCaps(ZOutTxt$)
  2500.       CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _
  2501.                    STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _
  2502.                    " more minutes" + _
  2503.                    STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds")
  2504.       CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX)
  2505.       ZOK = ZFalse
  2506.       ZLastIndex = 0
  2507.       END SUB
  2508. 60200 ' $SUBTITLE: 'MarkTime - Give feedback for lengthy processes'
  2509. ' $PAGE
  2510. '
  2511. '  NAME    --  MarkTime
  2512. '
  2513. '  INPUTS  --  PARAMETER                   MEANING
  2514. '              DotNumber          How many dots printed
  2515. '
  2516. '  OUTPUTS --  DotNumber
  2517. '
  2518. '  PURPOSE --  Marks time by putting colorized dots out
  2519. '              to 4, then erasing
  2520. '
  2521.       SUB MarkTime (DotNumber) STATIC
  2522.       TimeNow! = TIMER
  2523.       IF TimeNow! - PrevTI! < 1.0 THEN _
  2524.          EXIT SUB
  2525.       PrevTI! = TimeNow!
  2526.       IF RemoveDot AND DotNumber > 0 THEN _
  2527.          CALL QuickTPut (ZBackSpace$,0) : _
  2528.          DotNumber = DotNumber - 1 : _
  2529.          EXIT SUB
  2530.       DotNumber = DotNumber + 1
  2531.       ON DotNumber GOTO 60201,60202,60203,60204
  2532. 60201 WasX$ = ZFG1$
  2533.       RemoveDot = ZFalse
  2534.       GOTO 60205
  2535. 60202 WasX$ = ZFG2$
  2536.       GOTO 60205
  2537. 60203 WasX$ = ZFG3$
  2538.       GOTO 60205
  2539. 60204 WasX$ = ZFG4$
  2540.       RemoveDot = ZTrue
  2541. 60205 CALL QuickTPut (WasX$ + "." + ZEmphasizeOff$,0)
  2542.       END SUB
  2543. 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
  2544. ' $PAGE
  2545. '
  2546. '  NAME    --  AutoPage   'Contributed  by Gregg and Bob Snyder
  2547. '                        'and RoseMarie Siddiqui
  2548. '
  2549. '  INPUTS  --  ZAutoPageDef$  List of conditions that trigger
  2550. '                                       notification and how
  2551. '
  2552. '  OUTPUTS -- NONE
  2553. '
  2554. '  PURPOSE -- Search ZAutoPageDef$ for match on whether
  2555. '             on name, security level, whether new user.
  2556. '             Also controls whether caller notified and
  2557. '             number of times sysop has bell rung.
  2558. '             And what tune to play (if any).
  2559. '
  2560.       SUB AutoPage STATIC
  2561.       CALL FindIt (ZAutoPageDef$)
  2562.       IF NOT ZOK THEN _
  2563.          EXIT SUB
  2564.       ZErrCode = 0
  2565.       ZOK = ZFalse
  2566.       WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
  2567.          CALL ReadParms (ZWorkAra$(),4,1)
  2568.          IF ZErrCode = 0 THEN _
  2569.             ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
  2570.             IF NOT ZOK THEN _
  2571.                IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
  2572.                   ZOK = ZTrue _
  2573.                ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
  2574.                        ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
  2575.                        IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
  2576.                           IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
  2577.                              ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
  2578.                                 ZOK = ZTrue
  2579.       WEND
  2580.       CLOSE 2
  2581.       IF ZErrCode > 0 OR NOT ZOK THEN _
  2582.          ZErrCode = 0 : _
  2583.          EXIT SUB
  2584.       ZPageStatus$ = "AP!"
  2585.       IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
  2586.          ZOutTxt$ = "Telling sysop you're on..." : _
  2587.          CALL RingCaller
  2588.       ZWasB = (ZWorkAra$(4) = "")
  2589.       ZWorkAra$(5) = ""
  2590.      TempSnoop = ZSnoop
  2591.      ZSnoop = ZTrue
  2592.      CALL Line25
  2593.       FOR WasI = 1 TO VAL(ZWorkAra$(3))
  2594.          IF ZWasB THEN _
  2595.             CALL LPrnt (ZBellRinger$,0) : _
  2596.          ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
  2597.       NEXT
  2598.       IF NOT ZWasB THEN _
  2599.          CALL RBBSPlay (ZWorkAra$(5))
  2600.       ZSnoop = TempSnoop
  2601.       END SUB
  2602. 62520 ' $SUBTITLE: 'PutMsgAttr - subroutine to save msg. attributes'
  2603. ' $PAGE
  2604. '
  2605. '  NAME    --  PutMsgAttr
  2606. '
  2607. '  INPUTS  --  PARAMETER                   MEANING
  2608. '              ZWasQ
  2609. '              ZUserIn$
  2610. '              ZLinesInMsg
  2611. '              ZWasS
  2612. '              ZNonStop
  2613. '              ZMsgDimIndex
  2614. '
  2615. '  OUTPUTS --  ZWasSQ
  2616. '              ZWasLG$(10)
  2617. '              ZLinesInMsgSave
  2618. '              ZWasSL
  2619. '              ZNonStopSave
  2620. '              ZMsgDimIndexSave
  2621. '
  2622. '  PURPOSE --  WHEN REPLYING TO A MESSAGE THIS ROUTINE SAVES
  2623. '              THE ATTRIBUTES OF THE ORGINAL MESSAGE
  2624. '
  2625.       SUB PutMsgAttr STATIC
  2626.       ZWasSQ = ZWasQ
  2627.       ZWasLG$(10) = ZUserIn$
  2628.       ZLinesInMsgSave = ZLinesInMsg
  2629.       ZWasSL = ZWasS
  2630.       ZNonStopSave = ZNonStop
  2631.       ZMsgDimIndexSave = ZMsgDimIndex
  2632.       END SUB
  2633. 62530 ' $SUBTITLE: 'GetMsgAttr - subroutine to get msg. attributes'
  2634. ' $PAGE
  2635. '
  2636. '  NAME    --  GetMsgAttr
  2637. '
  2638. '  INPUTS  --  PARAMETER                   MEANING
  2639. '              ZWasSQ
  2640. '              ZWasLG$(10)
  2641. '              ZLinesInMsgSave
  2642. '              ZWasSL
  2643. '              ZNonStopSave
  2644. '              ZMsgDimIndexSave
  2645. '
  2646. '  OUTPUTS --  ZWasQ
  2647. '              ZUserIn$
  2648. '              LINES.IN.MESSAGESAVE
  2649. '              ZWasS
  2650. '              ZNonStop
  2651. '              ZMsgDimIndex
  2652. '              ZKillMessage
  2653. '
  2654. '  PURPOSE --  After replying to a message this routine restores
  2655. '              the attributes of the orginal message
  2656. '
  2657.       SUB GetMsgAttr STATIC
  2658.       ZWasQ = ZWasSQ
  2659.       ZUserIn$ = ZWasLG$(10)
  2660.       ZLinesInMsg = ZLinesInMsgSave
  2661.       ZWasS = ZWasSL
  2662.       ZNonStop = ZNonStopSave
  2663.       ZMsgDimIndex = ZMsgDimIndexSave
  2664.       ZKillMessage = ZFalse
  2665.       END SUB
  2666. 62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
  2667. ' $PAGE
  2668. '
  2669. '  NAME    --  RptTime
  2670. '
  2671. '  INPUTS  --  PARAMETER                   MEANING
  2672. '
  2673. '  OUTPUTS --
  2674. '
  2675. '  PURPOSE --  Tells user time used on system
  2676. '
  2677.       SUB RptTime STATIC
  2678.       CALL SkipLine (1)
  2679.       CALL GetTime
  2680.       CALL AMorPM
  2681.       Mins = (ZSessionHour * 60) + ZSessionMin
  2682.       CALL Carrier
  2683.       IF ZSubParm = -1 THEN _
  2684.          EXIT SUB
  2685.       CALL QuickTPut1 ("Now: " + DATE$ + " at " + TIME$)
  2686.       CALL QuickTPut1 ("On for" + STR$(Mins) + " mins," + _
  2687.                         STR$(ZSessionSec) + " secs")
  2688.       CALL Talk (7,ZOutTxt$)
  2689.       END SUB
  2690. 62600 ' $SUBTITLE: 'Protocol - Determine protocols available'
  2691. ' $PAGE
  2692. '
  2693. '  NAME    -- Protocol
  2694. '
  2695. '  INPUTS  --     PARAMETER                    MEANING
  2696. '                 ZProtoDef$                File of installed protocols
  2697. '
  2698. '  OUTPUTS -- ZTransferOption$         Prompt for protocol choice
  2699. '             ZDefaultXfer$            Letters of protocols
  2700. '             ZInternalEquiv$          Internal protocol to use
  2701. '
  2702. '  PURPOSE -- TO determine what protocols are available to user
  2703. '
  2704.       SUB Protocol STATIC
  2705.       CALL FindIt (ZProtoDef$)
  2706.       IF NOT ZOK THEN _
  2707.          ZTransferOption$ = "A)scii,X)modem,C)rcXmodem,Y)modem" : _
  2708.          ZInternalEquiv$ = "AXCY" : _
  2709.          ZDefaultXfer$ = "AXCY" : _
  2710.          GOTO 62604
  2711.       ZDefaultXfer$ = ""
  2712.       ZInternalEquiv$ = ""
  2713.       ZTransferOption$ = ""
  2714.       WasL = 0
  2715. 62602 IF EOF(2) THEN _
  2716.          GOTO 62604
  2717.       CALL ReadParms (ZWorkAra$(),13,1)
  2718.       IF ZErrCode > 0 THEN _
  2719.          EXIT SUB
  2720.       ZDefaultXfer$ = ZDefaultXfer$ + " "
  2721.       ZInternalEquiv$ = ZInternalEquiv$ + " "
  2722.       IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  2723.          GOTO 62602
  2724.       IF LEFT$(ZWorkAra$(5),1) = "R" THEN _
  2725.          IF NOT ZReliableMode THEN _
  2726.             GOTO 62602
  2727.       IF LEFT$(ZWorkAra$(3),1) = "I" THEN _
  2728.          GOTO 62603
  2729.       WasX = INSTR(ZWorkAra$(12)+" "," ")
  2730.       WasX$ = LEFT$(ZWorkAra$(12),WasX-1)
  2731.       CALL FindFile (WasX$,Found)
  2732.       IF Found THEN _
  2733.          WasX = INSTR(ZWorkAra$(13)+" "," ") : _
  2734.          WasX$ = LEFT$(ZWorkAra$(13),WasX-1) : _
  2735.          CALL FindFile (WasX$,Found)
  2736.       IF NOT Found THEN _
  2737.          GOTO 62602
  2738. 62603 MID$(ZDefaultXfer$,LEN(ZDefaultXfer$),1) = LEFT$(ZWorkAra$(1),1)
  2739.       CALL FindLast (ZWorkAra$(1),ZCrLf$,WasX,WasI)
  2740.       IF WasX > 0 AND WasX >= LEN(ZWorkAra$(1)) - 2 THEN _
  2741.          ZWorkAra$(1) = LEFT$(ZWorkAra$(1),WasX-1)
  2742.       IF (WasL + LEN(ZWorkAra$(1)) < 62) AND WasX = 0 THEN _
  2743.          ZTransferOption$ = ZTransferOption$ + "," + ZWorkAra$(1) : _
  2744.          WasL = WasL + LEN(ZWorkAra$(1)) + 1 _
  2745.       ELSE WasL = LEN(ZWorkAra$(1)) : _
  2746.            ZTransferOption$ = ZTransferOption$ + _
  2747.                               ZCrLf$ + _
  2748.                               ZWorkAra$(1)
  2749.       IF LEFT$(ZWorkAra$(3),1) = "I" AND RIGHT$(ZWorkAra$(3),1) <> "I" THEN _
  2750.          MID$(ZInternalEquiv$,LEN(ZInternalEquiv$),1) = RIGHT$(ZWorkAra$(3),1)
  2751.       GOTO 62602
  2752. 62604 IF INSTR(ZInternalEquiv$,"N") > 0 THEN _
  2753.          GOTO 62605
  2754.       IF WasX = 0 THEN _
  2755.          ZTransferOption$ = ZTransferOption$ + ",N)one" _
  2756.       ELSE ZTransferOption$ = ZTransferOption$ + ZCrLf$ + "N)one"
  2757.       ZDefaultXfer$ = ZDefaultXfer$ + "N"
  2758.       ZInternalEquiv$ = ZInternalEquiv$ + "N"
  2759. 62605 IF LEFT$(ZTransferOption$,1) = "," THEN _
  2760.          ZTransferOption$ = MID$(ZTransferOption$,2)
  2761.       IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _
  2762.          CALL QuickTPut1 ("Protocol "+ZUserXferDefault$+" unavailable.  Default reset to None") : _
  2763.          ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1)
  2764.       END SUB
  2765. 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
  2766. ' $PAGE
  2767. '
  2768. '  NAME    -- Transfer
  2769. '
  2770. '  INPUTS  --     PARAMETER                    MEANING
  2771. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2772. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2773. '              ZFileName$                NAME OF FILE FOR Transfer
  2774. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2775. '                                        TO BE USED BY KERMIT (COM1
  2776. '                                        OR COM2)
  2777. '              ZBPS                      = -1 FOR   300 BAUD
  2778. '                                        = -2 FOR   450 BAUD
  2779. '                                        = -3 FOR  1200 BAUD
  2780. '                                        = -4 FOR  2400 BAUD
  2781. '                                        = -5 FOR  4800 BAUD
  2782. '                                        = -6 FOR  9600 BAUD
  2783. '                                        = -7 FOR 19200 BAUD
  2784. '
  2785. '  OUTPUTS  -- NONE
  2786. '
  2787. '  PURPOSE -- To transfer files using external protocols
  2788. '
  2789.       SUB Transfer STATIC
  2790.       IF ZPrivateDoor THEN _
  2791.          CALL PrivDoorRtn : _
  2792.          EXIT SUB
  2793.       IF ZTransferFunction = 1 THEN _
  2794.          ZUserIn$ = ZDownTemplate$ : _
  2795.          ZWasZ$ = "send " _
  2796.       ELSE IF ZTransferFunction = 2 THEN _
  2797.               ZUserIn$ = ZUpTemplate$ : _
  2798.               ZWasZ$ = "receive "
  2799.       CALL MetaGSR (ZUserIn$,ZFalse)
  2800.       CALL QuickTPut1 ("Protocol     : "+ZProtoPrompt$)
  2801.       CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0)
  2802.       IF ZBatchTransfer THEN _
  2803.          CALL QuickTPut1 ("(BATCH)") : _
  2804.          CALL OpenWork (2,ZNodeWorkFile$) : _
  2805.          WHILE NOT EOF(2) : _
  2806.            CALL ReadAny : _
  2807.            CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
  2808.            CALL QuickTPut1 ("   "+ZWasY$+WasX$) : _
  2809.          WEND _
  2810.       ELSE CALL QuickTPut1 (ZFileNameHold$)
  2811.       IF ZAutoLogoffReq THEN _
  2812.          CALL QuickTPut1 ("Automatic logoff, if download OK")
  2813.       CALL PrivDoorRtn
  2814.       END SUB
  2815. 62624 ' $SUBTITLE: 'PrivDoorRtn - subroutine to exit as a private door.'
  2816. ' $PAGE
  2817. '
  2818. '  NAME    -- PrivDoorRtn
  2819. '
  2820. '  INPUTS  --     PARAMETER                    MEANING
  2821. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2822. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2823. '                                        = 3 USER REGISTRATION PGM
  2824. '              ZUserIn$                      NAME OF FILE TO EXIT TO
  2825. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2826. '                                        TO BE USED BY KERMIT (COM1
  2827. '                                        OR COM2)
  2828. '              ZBPS                      = -1 FOR   300 BAUD
  2829. '                                        = -2 FOR   450 BAUD
  2830. '                                        = -3 FOR  1200 BAUD
  2831. '                                        = -4 FOR  2400 BAUD
  2832. '                                        = -5 FOR  4800 BAUD
  2833. '                                        = -6 FOR  9600 BAUD
  2834. '                                        = -7 FOR 19200 BAUD
  2835. '
  2836. '  OUTPUTS -- NONE
  2837. '
  2838. '  PURPOSE -- To transfer control to another program
  2839. '
  2840.       SUB PrivDoorRtn STATIC
  2841.       IF ZPrivateDoor THEN _
  2842.          GOTO 62630
  2843.       IF ZFakeXRpt THEN _
  2844.          CALL FakeXRpt (ZWasFT$)
  2845.       IF ZAdvanceProtoWrite THEN _
  2846.          CALL OpenOutW ("XFER-"+ZNodeID$+".DEF") : _
  2847.          IF ZErrCode < 1 THEN _
  2848.             CALL PrintWorkA (ZFileName$+",,"+ZWasFT$) : _
  2849.             CLOSE 2
  2850.       IF ZProtoMethod$ = "S" THEN _
  2851.          GOTO 62629
  2852. 62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1)
  2853.       IF WasX$ = "" THEN _
  2854.          EXIT SUB
  2855.       CALL FindIt (WasX$)
  2856.       IF NOT ZOK THEN _
  2857.          ZOutTxt$ = "Missing door program" : _
  2858.          CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _
  2859.          ZSnoop = ZTrue : _
  2860.          CALL LPrnt (ZOutTxt$,1) : _
  2861.          EXIT SUB
  2862.       ZOutTxt$(1) = "CLS"
  2863.       GOSUB 62633
  2864.       ZOutTxt$(2) = "ECHO" + ZOutTxt$
  2865.       ZOutTxt$(3) = ZDiskForDos$ + _
  2866.               "COMMAND /C " + _
  2867.               ZUserIn$
  2868.       ZOutTxt$(4) = ZRBBSBat$
  2869.       ZPrivateDoor = ZTrue
  2870.       CALL QuickTPut1 ("Exiting to External Pgm for Transfer")
  2871.       LOCATE 25,1
  2872.       CALL LPrnt(ZLineFeed$,0)
  2873.       CALL RBBSExit (ZOutTxt$(),4)
  2874. 62629 GOSUB 62633
  2875.       CLS
  2876.       CALL LPrnt (ZOutTxt$,1)
  2877.       CALL ShellExit (ZUserIn$)
  2878. 62630 IF ZPrivateDoor THEN _
  2879.          CALL RestoreCom : _
  2880.          CALL DelayTime (7 + ZBPS) : _
  2881.          CALL SetBaud : _
  2882.          CALL QuickTPut1 ("Reloading RBBS-PC.  Please be patient.")
  2883. 62631 CALL SkipLine (2)
  2884.       LOCATE 24,1
  2885. 62632 EXIT SUB
  2886. 62633 ZOutTxt$ = STR$(ZUserSecLevel) + _
  2887.                  " " + _
  2888.                  ZActiveUserName$ + _
  2889.                  " " + _
  2890.                  ZWasCI$
  2891.       RETURN
  2892.       END SUB
  2893. 62650 ' $SUBTITLE: 'FakeXRpt - subroutine to create fake xfer report'
  2894. ' $PAGE
  2895. '
  2896. '  NAME    --  FakeXRpt
  2897. '
  2898. '  INPUTS  --  PARAMETER                   MEANING
  2899. '              ZFileNameHold$      FILE TO BE TRANSFERRED
  2900. '              ProtoUsed$          Protocol USED
  2901. '
  2902. '  OUTPUTS --  WRITES OUT Transfer FILE REPORT
  2903. '
  2904. '  PURPOSE --  External protocol drivers that do not write
  2905. '              out a standard transfer report must have one
  2906. '              provided in order for "dooring" to external
  2907. '              protocols to work properly, since this file
  2908. '              is read upon returning from an external protocol.
  2909. '
  2910.       SUB FakeXRpt (ProtoUsed$) STATIC
  2911.       CLOSE 2
  2912.       OPEN "O",2,"XFER-" + _
  2913.                  ZNodeFileID$ + _
  2914.                  ".DEF"
  2915.       PRINT #2,ZFileName$
  2916.       PRINT #2,
  2917.       PRINT #2,ProtoUsed$
  2918.       PRINT #2,"S"
  2919.       CLOSE 2
  2920.       END SUB
  2921. 62660 ' $SUBTITLE: 'SetExpert - subroutine to adjust for expert change'
  2922. ' $PAGE
  2923. '
  2924. '  NAME    --  SetExpert
  2925. '
  2926. '  INPUTS  --  PARAMETER                   MEANING
  2927. '              ZExpertUser          WHETHER IS AN EXPERT
  2928. '
  2929. '  OUTPUTS --  ZMorePrompt$         Pause prompt
  2930. '              ZPressEnter$         Prompt to press enter
  2931. '
  2932. '  PURPOSE --  Make more helpful prompt for novices and shorter
  2933. '              one for experts
  2934. '
  2935.       SUB SetExpert STATIC
  2936.       IF ZExpertUser THEN _
  2937.          ZMorePrompt$ = "More <[Y],N,C,A" : _
  2938.          ZPressEnter$ = ZPressEnterExpert$ : _
  2939.          EXIT SUB
  2940.       ZMorePrompt$ = "More [Y]es,N)o,C)ont,A)bort"
  2941.       ZPressEnter$ = ZPressEnterNovice$
  2942.       END SUB
  2943. 62668 ' $SUBTITLE: 'NewPassword - subroutine to get new password'
  2944. ' $PAGE
  2945. '
  2946. '  NAME    --  NewPassword
  2947. '
  2948. '  INPUTS  --  PARAMETER                   MEANING
  2949. '              Prompt$               Prompt to display
  2950. '              DisallowSpaces        Whether answer can have all spaces
  2951. '
  2952. '  OUTPUTS --  ZWasZ$                   Password
  2953. '
  2954. '  PURPOSE --  To get a new password.
  2955. '
  2956.       SUB NewPassword (Prompt$,DisallowSpaces) STATIC
  2957. 62670 ZOutTxt$ = Prompt$
  2958.       ZHidden = ZTrue
  2959.       CALL PopCmdStack
  2960.       ZHidden = ZFalse
  2961.       IF ZSubParm < 0 OR ZWasQ = 0 THEN _
  2962.          EXIT SUB
  2963.       IF LEN(ZUserIn$) > 15 THEN _
  2964.          CALL QuickTPut1 ("15 chars max") : _
  2965.          GOTO 62670
  2966.       IF INSTR(ZUserIn$,";") > 0 THEN _
  2967.          CALL QuickTPut1 ("Cannot use ';'") : _
  2968.          GOTO 62670
  2969.       IF DisallowSpaces THEN _
  2970.          IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
  2971.             CALL QuickTPut1 ("Not all blanks") : _
  2972.             GOTO 62670
  2973.       CALL AllCaps (ZUserIn$)
  2974.       ZWasZ$ = ZUserIn$
  2975.       END SUB
  2976. 63000 ' $SUBTITLE: 'TimedOut - exits based on time of day'
  2977. ' $PAGE
  2978. '
  2979. '  NAME    --  TimedOut
  2980. '
  2981. '  INPUTS  --  PARAMETER                   MEANING
  2982. '              ZRCTTYBat$
  2983. '              ZNodeRecIndex
  2984. '              ZMsgRec$
  2985. '              ZModemInitBaud$
  2986. '              ZModemGoOffHookCmnd$
  2987. '
  2988. '  OUTPUTS --  NONE
  2989. '
  2990. '  PURPOSE --  When RBBS-PC is to exit to DOS at a specific time of
  2991. '              day, this routine writes out to the file specified
  2992. '              in "RCTTY.BAT" the one-line entry:
  2993. '                          RBBSxTM.BAT
  2994. '               WHERE "x" is the node id.
  2995. '
  2996.       SUB TimedOut STATIC
  2997.       FIELD #1,128 AS ZMsgRec$
  2998.       ZSubParm = 3
  2999.       CALL FileLock
  3000.       GET 1,ZNodeRecIndex
  3001.       WasX$ = DATE$
  3002.       CALL PackDate (WasX$,ZWasY$)
  3003.       MID$(ZMsgRec$,77,2) = ZWasY$
  3004.       'MID$(ZMsgRec$,86,5) = LEFT$(TIME$,5)
  3005.       PUT 1,ZNodeRecIndex
  3006.       ZSubParm = 2
  3007.       CALL FileLock
  3008.       CLOSE 2
  3009.       ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "TM.DEF"
  3010.       OPEN "O",2,ZFileName$
  3011.       PRINT #2,MID$(ZFileName$,3,7)
  3012.       CLOSE 2
  3013.       IF ZLocalUserMode THEN _
  3014.          EXIT SUB
  3015.       IF ZSubParm <> 7 THEN _
  3016.          ZSubParm = 4 : _
  3017.          CALL FileLock : _
  3018.          CALL OpenCom(ZModemInitBaud$,",N,8,1")
  3019.       CALL TakeOffHook
  3020.       END SUB
  3021. 64003 ' $SUBTITLE: 'AskUsers - subroutine to get registration information'
  3022. ' $PAGE
  3023. '
  3024. '  NAME    --  AskUsers  (WRITTEN BY JON MARTIN)
  3025. '
  3026. '  INPUTS  --  PARAMETER                   MEANING
  3027. '              ZFileName$           NAME OF THE FILE CONTAINING THE
  3028. '                                   SCRIPT TO BE USED WHEN ASKING
  3029. '                                   THE USER QUESTIONS.
  3030. '              ZActiveUserName$     NAME OF THE CURRENT USER
  3031. '              ZUserSecLevel        USER'S SECURITY
  3032. '              ZUpperCase           SET IF USER NEEDS UPPERCASE
  3033. '
  3034. '  OUTPUTS --  WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE
  3035. '              FILE NAME SPECIFIED AS THE First PARAMETER IN THE
  3036. '              First RECORD OF THE FILE CONTAINING THE SCRIPT TO
  3037. '              BE USED.
  3038. '              ZUserSecLevel  CAN BE RAISED OR LOWERED
  3039. '
  3040. '  PURPOSE --  Provides a sophisticated, script driven mechanism by
  3041. '              which a sysop can control the interaction with the
  3042. '              user.  Special function questionnaires include the
  3043. '              registration questionnaire and the epilog.
  3044. '
  3045.       SUB AskUsers STATIC
  3046.       ZQuestAborted = ZFalse
  3047.       ZQuestChainStarted = ZFalse
  3048.       REDIM ZOutTxt$(256)
  3049.       REDIM ZWorkAra$(ZMaxWorkVar),ZGSRAra$(ZMaxWorkVar)
  3050.       PrevAppend$ = ""
  3051.       AppendFileName$ = ""
  3052. '
  3053. '
  3054. ' *  LOAD SCRIPT CONTAINING THE QUESTIONS INTO THE ZOutTxt$ DIMENSION  *
  3055. '
  3056. '
  3057. 64005 ZChatAvail = ZFalse
  3058.       QestChain = ZFalse
  3059.       LastQues = 0
  3060.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  3061.       IF NOT ZOK THEN _
  3062.          EXIT SUB
  3063.       CALL ReadParms (ZOutTxt$(),2,1)
  3064.       IF ZErrCode > 0 THEN _
  3065.          EXIT SUB
  3066.       PrevAppend$ = AppendFileName$
  3067.       AppendFileName$ = ZOutTxt$(1)
  3068.       MaxSecLevel = VAL(ZOutTxt$(2))
  3069.       WasX = INSTR(ZOutTxt$(2)," ")
  3070.       IF WasX > 0 THEN _
  3071.          IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _
  3072.             CALL QuickTPut1 ("Higher security needed for questionnaire") : _
  3073.             EXIT SUB
  3074. '
  3075. '
  3076. ' *  THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS:
  3077. ' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.
  3078. ' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY
  3079. ' *   3.  THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE
  3080. ' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6,
  3081. ' *      and requires security 5 or more to access
  3082.       ScriptIndex = 1
  3083.       ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _
  3084.                          " " + _
  3085.                          DATE$ + _
  3086.                          " " + _
  3087.                          TIME$
  3088. 64010 IF EOF(2) OR ScriptIndex > 255 THEN _
  3089.          GOTO 64100
  3090.       ScriptIndex = ScriptIndex + 1
  3091.       LINE INPUT #2,ZOutTxt$(ScriptIndex)
  3092.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  3093.          Temp$ = ZOutTxt$(ScriptIndex) : _
  3094.          CALL AllCaps (Temp$) : _
  3095.          CALL Trim (Temp$) : _
  3096.          ZOutTxt$(ScriptIndex) = Temp$
  3097.       IF ZUpperCase THEN _
  3098.          CALL AllCaps (ZOutTxt$(ScriptIndex))
  3099.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "?" THEN _
  3100.          ScriptIndex = ScriptIndex + 1 : _
  3101.          ZOutTxt$(ScriptIndex) = "!"
  3102.       GOTO 64010
  3103. '
  3104. '
  3105. ' *  PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS:
  3106. ' *
  3107. ' * First COLUMN     MEANING
  3108. ' *      :        THIS LINE IS A LABEL THAT MAY BE BRANCHED TO
  3109. ' *      !        THIS MEANS THIS IS AN ANSWER
  3110. ' *      >        THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS
  3111. ' *      *        THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER
  3112. ' *      ?        THIS MEANS THIS IS A QUESTION FOR THE USER
  3113. ' *      =        THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA
  3114. ' *      -        THIS MEANS TO LOWER THE USER'S SECURITY LEVEL
  3115. ' *      +        THIS MEANS TO RAISE THE USER'S SECURITY LEVEL
  3116. ' *      @        THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT
  3117. ' *      &        THIS MEANS TO CHAIN TO ANOTHER QUESTIONNAIRE
  3118. ' *      M        Execute specified macro
  3119. ' *      T        Turbo Key
  3120. ' *      <        Assign value to work variable
  3121. '
  3122. 64100 ScriptMax = ScriptIndex
  3123.       ScriptIndex = 1
  3124. 64110 CALL Carrier
  3125.       IF ZSubParm = -1 THEN _
  3126.          GOTO 64510
  3127.       ScriptIndex = ScriptIndex + 1
  3128.       IF ScriptIndex > ScriptMax THEN _
  3129.          GOTO 64400
  3130.       ZOutTxt$ = MID$(ZOutTxt$(ScriptIndex),2)
  3131.       WasX = ZFalse
  3132.       IF LEFT$(ZOutTxt$,3) = "/FL" THEN _
  3133.          ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _
  3134.          WasX = ZTrue
  3135.       CALL MetaGSR (ZOutTxt$,WasX)
  3136.       CALL SmartText (ZOutTxt$,ZFalse,WasX)
  3137.       WasX$ = ZOutTxt$
  3138.       ON INSTR(" :!@MT><*?=-+&",LEFT$(ZOutTxt$(ScriptIndex),1)) GOTO _
  3139.          64111, _       ' catch invalid lines
  3140.          64110, _       ' : label
  3141.          64110, _       ' ! stored answer
  3142.          64420, _       ' @ abort
  3143.          64120, _       ' M macro execute
  3144.          64430, _       ' T turbo key
  3145.          64440, _       ' > goto label
  3146.          64190, _       ' < assign value
  3147.          64450, _       ' * display line
  3148.          64113, _       ' ? prompt for answer
  3149.          64114, _       ' = conditional branch
  3150.          64460, _       ' - decrease security level
  3151.          64465, _       ' + increase security level
  3152.          64470          ' & chain
  3153. 64111 ZOutTxt$ = "Invalid line.  Column 1 is <" + LEFT$(ZOutTxt$(ScriptIndex),1)+">.  Must be: * ? = + - > @ & M T <"
  3154.       ZSubParm = 5
  3155.       CALL TPut
  3156.       GOTO 64510
  3157. 64113 LastQues = ScriptIndex  ' process ?
  3158.       GOSUB 64180
  3159.       ZSubParm = 1
  3160.       CALL TGet
  3161.       IF ZSubParm = -1 THEN _
  3162.          GOTO 64510 _
  3163.       ELSE IF ZWasQ = 0 THEN _
  3164.               ZOutTxt$ = WasX$ : _
  3165.               GOTO 64113 _
  3166.            ELSE ZOutTxt$(ScriptIndex + 1) = "!" + _
  3167.                                        ZUserIn$ : _
  3168.                 ZGSRAra$(ZTestedIntValue) = ZUserIn$
  3169.       GOTO 64110
  3170. 64114 IF LEFT$(ZOutTxt$(ScriptIndex),2) = "=#" THEN _        ' Numeric
  3171.          GOSUB 64350 : _
  3172.          GOTO 64110
  3173.       GOSUB 64300             ' process =
  3174.       GOTO 64445
  3175. 64120 ZWasZ$ = MID$(ZOutTxt$(ScriptIndex),2)   ' Execute macro
  3176.       CALL Trim (ZWasZ$)
  3177.       CALL Macro (ZWasZ$,Found)
  3178.       IF Found THEN _
  3179.           CALL FDMACEXE
  3180.       GOTO 64110
  3181. 64180 CALL CheckInt (ZOutTxt$)
  3182.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  3183.           (ZTestedIntValue > ZMaxWorkVar) OR _
  3184.           (INSTR("123456789",LEFT$(ZOutTxt$,1)) = 0) THEN _
  3185.              ZTestedIntValue = 0 _
  3186.       ELSE ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-1+(ZTestedIntValue > 9))
  3187.       RETURN
  3188. 64190 GOSUB 64180
  3189.       IF ZTestedIntValue > 0 THEN _
  3190.          ZGSRAra$(ZTestedIntValue) = MID$(ZOutTxt$,2)
  3191.       GOTO 64110
  3192. '
  3193. '
  3194. ' *  SEARCH FOR GOTO LABEL
  3195. '
  3196. '
  3197. 64200 ScriptIndex = 1
  3198.       CALL MetaGSR (BranchLabel$,ZFalse)
  3199.       CALL SmartText (BranchLabel$,ZFalse,ZFalse)
  3200.       CALL AllCaps (BranchLabel$)
  3201.       CALL Trim (BranchLabel$)
  3202. 64210 ScriptIndex = ScriptIndex + 1
  3203.       IF ScriptIndex > ScriptMax THEN _
  3204.          ZOutTxt$ = BranchLabel$ + _
  3205.               " not found!" : _
  3206.          ZSubParm = 5 : _
  3207.          CALL TPut : _
  3208.          IF ZSubParm = -1 THEN _
  3209.             RETURN _
  3210.          ELSE IF LastQues > 0 THEN _
  3211.                  ScriptIndex = LastQues - 1 : _
  3212.                  RETURN _
  3213.               ELSE GOTO 64510
  3214.       IF LEFT$(ZOutTxt$(ScriptIndex),1) <> ":" THEN _
  3215.          GOTO 64210
  3216.       IF MID$(ZOutTxt$(ScriptIndex),2) <> BranchLabel$ THEN _
  3217.          GOTO 64210
  3218.       RETURN
  3219. '
  3220. '
  3221. ' *  DETERMINE BRANCH LOGIC
  3222. '
  3223. '
  3224. 64300 CurEquals = 1
  3225.       ZWasZ$ = RIGHT$(ZOutTxt$(LastQues + 1),1)
  3226.       CALL AllCaps (ZWasZ$)
  3227. 64310 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  3228.       IF NextEquals = 0 THEN _
  3229.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  3230.          GOTO 64320
  3231.       IF ZWasZ$ <> _
  3232.          MID$(ZOutTxt$(ScriptIndex),CurEquals + 1,1) THEN  _
  3233.          CurEquals = NextEquals : _
  3234.          GOTO 64310
  3235.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  3236. 64320 GOSUB 64200
  3237.       RETURN
  3238. '
  3239. '
  3240. ' *  DETERMINE Numeric BRANCH LOGIC
  3241. '
  3242. '
  3243. 64350 CurEquals = 1
  3244. 64360 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  3245.       IF NextEquals = 0 THEN _
  3246.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  3247.          GOTO 64380
  3248.       Numeric = ZTrue
  3249.       LoopIndex = 2
  3250.       WHILE LoopIndex < LEN(ZOutTxt$(ScriptIndex - 1)) +1
  3251.          IF INSTR("()1234567890- ",MID$(ZOutTxt$(ScriptIndex - 1),LoopIndex,1)) THEN _
  3252.             GOTO 64370
  3253.          Numeric = ZFalse
  3254. 64370    LoopIndex = LoopIndex + 1
  3255.       WEND
  3256.       IF NOT Numeric THEN _
  3257.          CurEquals = NextEquals : _
  3258.          GOTO 64360
  3259.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  3260. 64380 GOSUB 64200
  3261.       RETURN
  3262. '
  3263. '
  3264. ' *  WRITE RESPONSES TO DESIGNATED FILE
  3265. '
  3266. '
  3267. 64400 ScriptIndex = 0
  3268.       ZWasEN$ = AppendFileName$
  3269.       CALL LockAppend
  3270.       IF ZErrCode <> 0 THEN _
  3271.          ZOutTxt$ = "Fatal Error in script!" : _
  3272.          ZSubParm = 5 : _
  3273.          CALL TPut : _
  3274.          GOTO 64500
  3275. 64410 ScriptIndex = ScriptIndex + 1
  3276.       IF ScriptIndex > ScriptMax THEN _
  3277.          GOTO 64500
  3278.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  3279.          QuestionSave$ = MID$(ZOutTxt$(ScriptIndex),2) : _
  3280.          GOTO 64410
  3281.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" AND _
  3282.          LEN(ZOutTxt$(ScriptIndex)) < 2 THEN _
  3283.          GOTO 64410
  3284.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" THEN _
  3285.          CALL PrintWorkA (QuestionSave$) : _
  3286.          CALL PrintWorkA (MID$(ZOutTxt$(ScriptIndex),2))
  3287.       IF ScriptIndex = 1 AND _
  3288.          AppendFileName$ <> PrevAppend$ THEN _
  3289.          CALL PrintWorkA (ZOutTxt$(ScriptIndex))
  3290.       IF ZErrCode <> 0 THEN _
  3291.          ZOutTxt$ = "Unrecoverable failure in script!" : _
  3292.          ZSubParm = 5 : _
  3293.          CALL TPut : _
  3294.          GOTO 64500
  3295.       GOTO 64410
  3296. 64420 ZQuestAborted = ZTrue  ' @ abort
  3297.       GOTO 64510
  3298. 64430 ZTurboKey = -ZTurboKeyUser   ' T turbo key
  3299.       GOTO 64110
  3300. 64440 BranchLabel$ = ZOutTxt$            ' = branch
  3301.       GOSUB 64200
  3302. 64445 IF ZSubParm = -1 THEN _
  3303.          GOTO 64510 _
  3304.       ELSE GOTO 64110
  3305. 64450 ZSubParm = 5      ' * display
  3306.       CALL TPut
  3307.       GOTO 64445
  3308. 64460 WasX = -1        ' - lower security
  3309. 64462 CALL CheckInt (ZOutTxt$)
  3310.       IF ZErrCode = 0 THEN _
  3311.          Temp = ZUserSecLevel + _
  3312.             WasX * ZTestedIntValue : _
  3313.          IF Temp <= MaxSecLevel THEN _
  3314.             ZUserSecLevel = Temp : _
  3315.             ZUserSecSave = ZUserSecLevel : _
  3316.             ZAdjustedSecurity = ZTrue
  3317.             IF ZOrigMsgFile$ = ZActiveMessageFile$ THEN _
  3318.                ZOrigSec = ZUserSecLevel
  3319.       GOTO 64110
  3320. 64465 WasX = 1               ' + raise security
  3321.       GOTO 64462
  3322. 64470 QestChain = ZTrue  ' & chain questionnaires
  3323.       ZFileNameHold$ = ZOutTxt$
  3324.       GOTO 64110
  3325. 64500 CALL UnLockAppend
  3326.       CALL Carrier
  3327.       IF QestChain THEN _
  3328.          ZQuestChainStarted = ZTrue : _
  3329.          ZFileName$ = ZFileNameHold$ : _
  3330.          GOTO 64005
  3331. 64510 ZChatAvail = (INSTR("MUF",ZActiveMenu$) > 0)
  3332.       ZOK = ZTrue
  3333.       ZLastIndex = 0
  3334.       END SUB
  3335. 64600 ' $SUBTITLE: 'ViewArc - subroutine to display .ARC contents'
  3336. ' $PAGE
  3337. '
  3338. '  NAME    --  ViewArc  (Written by Jon Martin)
  3339. '
  3340. '  INPUTS  --  PARAMETER                   MEANING
  3341. '              ZFileName$           NAME OF THE ARC FILE TO BE
  3342. '                                   VIEWED.
  3343. '
  3344. '  OUTPUTS --  NONE
  3345. '
  3346. '  PURPOSE --  Provides a mechanism to provide users with the
  3347. '              contents of a libraried file prior to downloading.
  3348. '
  3349.       SUB ViewArc STATIC
  3350.       CLOSE 2
  3351.       'IF ZTurboRBBS THEN _
  3352.          RetCode = 0
  3353.          CALL ArcV (ZArcWork$,ZFileName$,RetCode)
  3354.          CALL BufFile (ZArcWork$,WasX)
  3355.          EXIT SUB
  3356.       'IF ZShareIt THEN _
  3357.       '   OPEN ZFileName$ FOR RANDOM SHARED AS #2 LEN=1 _
  3358.       'ELSE OPEN "R",2,ZFileName$,1
  3359.       'FIELD 2,1 AS CHAR$
  3360.       'BYTE.POINTER! = 1
  3361.       'ARC.END! = LOF(2)
  3362. 64605 'IF BYTE.POINTER! > ARC.END! THEN _
  3363.       '   GOTO 64620
  3364.       'GET 2,BYTE.POINTER!
  3365.       'IF CHAR$ <> CHR$(26) THEN _
  3366.       '   GOTO 64620
  3367.       'BYTE.POINTER! = BYTE.POINTER! + 1
  3368.       'GET 2,BYTE.POINTER!
  3369.       'IF CHAR$ = CHR$(0) THEN _
  3370.       '   GOTO 64620
  3371.       'ARCED.NAME$ = ""
  3372.       'FOR WasX = 1 TO 12
  3373.       '   GET 2,BYTE.POINTER! + WasX
  3374.       '   IF CHAR$ < CHR$(40) THEN _
  3375.       '      GOTO 64610
  3376.       '   ARCED.NAME$ = ARCED.NAME$ + _
  3377.       '                 CHAR$
  3378.       'NEXT
  3379. 64610 'ZOutTxt$ = ARCED.NAME$
  3380.       'BYTE.POINTER! = BYTE.POINTER! + 14
  3381.       'GOSUB 64630
  3382.       'TOTAL.BYTES# = WORK.BYTES#
  3383.       'BYTE.POINTER! = BYTE.POINTER! + 10
  3384.       'GOSUB 64630
  3385.       'FINAL.BYTES# = WORK.BYTES#
  3386.       'ZOutTxt$ = ZOutTxt$ + _
  3387.       '     SPACE$(20 - LEN(ARCED.NAME$) - LEN(STR$(FINAL.BYTES#))) + _
  3388.       '     STR$(FINAL.BYTES#) + _
  3389.       '     " bytes."
  3390.       'CALL QuickTPut1 (ZOutTxt$)
  3391.       'BYTE.POINTER! = BYTE.POINTER! + TOTAL.BYTES# + 4
  3392.       'GOTO 64605
  3393. 64620 'CLOSE 2
  3394.       'ZSubParm = 0
  3395.       'CALL Carrier
  3396.       'ZOutTxt$ = ""
  3397.       'EXIT SUB
  3398. 64630 'FACTOR# = 1#
  3399.       'WORK.BYTES# = 0
  3400.       'FOR WasX = 0 TO 3
  3401.       '   GET 2,BYTE.POINTER! + WasX
  3402.       '   WORK.BYTES# = WORK.BYTES# + FACTOR# * ASC(CHAR$)
  3403.       '   FACTOR# = FACTOR# * 256#
  3404.       'NEXT
  3405.       'RETURN
  3406.       END SUB
  3407.